[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Enable TcM plugins in initTc
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: de44e69e by sheaf at 2025-09-19T05:16:51-04:00 Enable TcM plugins in initTc This commit ensures that we run typechecker plugins and defaulting plugins whenever we call initTc. In particular, this ensures that the pattern-match checker, which calls 'initTcDsForSolver' which calls 'initTc', runs with typechecker plugins enabled. This matters for situations like: merge :: Vec n a -> Vec n a -> Vec (2 * n) a merge Nil Nil = Nil merge (a <: as) (b <: bs) = a :< (b <: merge as bs) in which we need the typechecker plugin to run in order to tell us that the Givens would be inconsistent in the additional equation merge (_ <: _) Nil and thus that the equation is not needed. Fixes #26395 - - - - - 2c378ad2 by Cheng Shao at 2025-09-19T05:17:33-04:00 rel-eng: update fedora image to 42 This patch is a part of #25876 and updates fedora image to 42. - - - - - c0344aa2 by Sylvain Henry at 2025-09-19T05:50:44-04:00 Fix output of T14999 (#23685) Fix output of T14999 to: - take into account the +1 offset to DW_AT_low_pc (see Note [Info Offset]) - always use Intel's syntax to force consistency: it was reported that sometimes GDB prints `jmpq` instead of `jmp` with the AT&T syntax - - - - - 7e856487 by Vladislav Zavialov at 2025-09-19T05:50:44-04:00 Fix PREP_MAYBE_LIBRARY in prep_target_file.m4 This change fixes a configure error introduced in: commit 8235dd8c4945db9cb03e3be3c388d729d576ed1e ghc-toolchain: Move UseLibdw to per-Target file Now the build no longer fails with: acghc-toolchain: Failed to read a valid Target value from hadrian/cfg/default.target - - - - - 15 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/HsToCore/Monad.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Monad.hs - m4/prep_target_file.m4 - testsuite/tests/codeGen/should_compile/Makefile - testsuite/tests/codeGen/should_compile/T14999.stdout - + testsuite/tests/tcplugins/T26395.hs - + testsuite/tests/tcplugins/T26395.stderr - + testsuite/tests/tcplugins/T26395_Plugin.hs - testsuite/tests/tcplugins/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: be4ac2cd18f38e63b263e2a27c76a7c279385796 + DOCKER_REV: a97d5c67d803c6b3811c6cccdf33dc8e9d7eafe3 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -433,14 +433,14 @@ hadrian-ghc-in-ghci: hadrian-multi: stage: testing needs: - - job: x86_64-linux-fedora33-release + - job: x86_64-linux-fedora42-release optional: true - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release optional: true - - job: release-x86_64-linux-fedora33-release + - job: release-x86_64-linux-fedora42-release optional: true dependencies: null - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" before_script: # workaround for docker permissions - sudo chown ghc:ghc -R . @@ -460,7 +460,7 @@ hadrian-multi: - ls - | mkdir tmp - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp + tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp pushd tmp/ghc-*/ ./configure --prefix=$root make install @@ -522,17 +522,17 @@ test-cabal-reinstall-x86_64-linux-deb10: abi-test-nightly: stage: full-build needs: - - job: nightly-x86_64-linux-fedora33-release-hackage - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release-hackage + - job: nightly-x86_64-linux-fedora42-release tags: - x86_64-linux - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" dependencies: null before_script: - mkdir -p normal - mkdir -p hackage - - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C normal/ - - tar -xf ghc-x86_64-linux-fedora33-release-hackage_docs.tar.xz -C hackage/ + - tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C normal/ + - tar -xf ghc-x86_64-linux-fedora42-release-hackage_docs.tar.xz -C hackage/ script: - .gitlab/ci.sh compare_interfaces_of "normal/ghc-*" "hackage/ghc-*" artifacts: @@ -609,9 +609,9 @@ doc-tarball: hackage-doc-tarball: stage: packaging needs: - - job: nightly-x86_64-linux-fedora33-release-hackage + - job: nightly-x86_64-linux-fedora42-release-hackage optional: true - - job: release-x86_64-linux-fedora33-release-hackage + - job: release-x86_64-linux-fedora42-release-hackage optional: true - job: source-tarball tags: @@ -628,7 +628,7 @@ hackage-doc-tarball: - hackage_docs before_script: - tar -xf ghc-*[0-9]-src.tar.xz - - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C ghc*/ + - tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C ghc*/ script: - cd ghc*/ - mv .gitlab/rel_eng/upload_ghc_libs.py . @@ -754,7 +754,7 @@ test-bootstrap: # Triggering jobs in the ghc/head.hackage project requires that we have a job # token for that repository. Furthermore the head.hackage CI job must have # access to an unprivileged access token with the ability to query the ghc/ghc -# project such that it can find the job ID of the fedora33 job for the current +# project such that it can find the job ID of the fedora42 job for the current # pipeline. # # hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. @@ -841,7 +841,7 @@ nightly-hackage-lint: nightly-hackage-perf: needs: - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release optional: true artifacts: false - job: nightly-aarch64-linux-deb12-validate @@ -860,7 +860,7 @@ nightly-hackage-perf: release-hackage-lint: needs: - - job: release-x86_64-linux-fedora33-release + - job: release-x86_64-linux-fedora42-release optional: true artifacts: false - job: release-aarch64-linux-deb12-release+no_split_sections @@ -946,13 +946,13 @@ perf-nofib: allow_failure: true stage: testing needs: - - job: x86_64-linux-fedora33-release + - job: x86_64-linux-fedora42-release optional: true - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release optional: true - - job: release-x86_64-linux-fedora33-release + - job: release-x86_64-linux-fedora42-release optional: true - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" rules: - when: never - *full-ci @@ -965,7 +965,7 @@ perf-nofib: - root=$(pwd)/ghc - | mkdir tmp - tar -xf ../ghc-x86_64-linux-fedora33-release.tar.xz -C tmp + tar -xf ../ghc-x86_64-linux-fedora42-release.tar.xz -C tmp pushd tmp/ghc-*/ ./configure --prefix=$root make install @@ -989,21 +989,24 @@ perf-nofib: perf: stage: testing needs: - - job: x86_64-linux-fedora33-release + - job: x86_64-linux-fedora42-release optional: true - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release optional: true - - job: release-x86_64-linux-fedora33-release + - job: release-x86_64-linux-fedora42-release optional: true dependencies: null - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" tags: - x86_64-linux-perf + before_script: + # workaround for docker permissions + - sudo chown ghc:ghc -R . script: - root=$(pwd)/ghc - | mkdir tmp - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp + tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp pushd tmp/ghc-*/ ./configure --prefix=$root make install @@ -1027,14 +1030,14 @@ perf: abi-test: stage: testing needs: - - job: x86_64-linux-fedora33-release + - job: x86_64-linux-fedora42-release optional: true - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release optional: true - - job: release-x86_64-linux-fedora33-release + - job: release-x86_64-linux-fedora42-release optional: true dependencies: null - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" rules: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' @@ -1045,7 +1048,7 @@ abi-test: - root=$(pwd)/ghc - | mkdir tmp - tar -xf ghc-x86_64-linux-fedora33-release.tar.xz -C tmp + tar -xf ghc-x86_64-linux-fedora42-release.tar.xz -C tmp pushd tmp/ghc-*/ ./configure --prefix=$root make install @@ -1200,7 +1203,7 @@ ghcup-metadata-nightly: extends: .ghcup-metadata # Explicit needs for validate pipeline because we only need certain bindists needs: - - job: nightly-x86_64-linux-fedora33-release + - job: nightly-x86_64-linux-fedora42-release artifacts: false - job: nightly-x86_64-linux-ubuntu24_04-validate artifacts: false @@ -1251,7 +1254,7 @@ ghcup-metadata-nightly: # Update the ghcup metadata with information about this nightly pipeline ghcup-metadata-nightly-push: stage: deploy - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV" dependencies: null tags: - x86_64-linux ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -82,7 +82,7 @@ The generated names for the jobs is important as there are a few downstream cons of the jobs artifacts. Therefore some care should be taken if changing the generated names of jobs to update these other places. -1. Fedora33 jobs are required by head.hackage +1. fedora42 jobs are required by head.hackage 2. The fetch-gitlab release utility pulls release artifacts from the 3. The ghc-head-from script downloads release artifacts based on a pipeline change. 4. Some subsequent CI jobs have explicit dependencies (for example docs-tarball, perf, perf-nofib) @@ -118,8 +118,7 @@ data LinuxDistro | Debian11Js | Debian10 | Debian9 - | Fedora33 - | Fedora38 + | Fedora42 | Ubuntu2404LoongArch64 | Ubuntu2404 | Ubuntu2204 @@ -319,8 +318,7 @@ distroName Debian12Riscv = "deb12-riscv" distroName Debian12Wine = "deb12-wine" distroName Debian10 = "deb10" distroName Debian9 = "deb9" -distroName Fedora33 = "fedora33" -distroName Fedora38 = "fedora38" +distroName Fedora42 = "fedora42" distroName Ubuntu2404LoongArch64 = "ubuntu24_04-loongarch" distroName Ubuntu1804 = "ubuntu18_04" distroName Ubuntu2004 = "ubuntu20_04" @@ -501,14 +499,6 @@ alpineVariables arch = mconcat $ distroVariables :: Arch -> LinuxDistro -> Variables distroVariables arch Alpine312 = alpineVariables arch distroVariables arch Alpine322 = alpineVariables arch -distroVariables _ Fedora33 = mconcat - -- LLC/OPT do not work for some reason in our fedora images - -- These tests fail with this error: T11649 T5681 T7571 T8131b - -- +/opt/llvm/bin/opt: /lib64/libtinfo.so.5: no version information available (required by /opt/llvm/bin/opt) - -- +/opt/llvm/bin/llc: /lib64/libtinfo.so.5: no version information available (required by /opt/llvm/bin/llc) - [ "LLC" =: "/bin/false" - , "OPT" =: "/bin/false" - ] distroVariables _ _ = mempty ----------------------------------------------------------------------------- @@ -1207,13 +1197,13 @@ rhel_x86 = fedora_x86 :: [JobGroup Job] fedora_x86 = - [ -- Fedora33 job is always built with perf so there's one job in the normal + [ -- Fedora42 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) + fastCI (standardBuildsWithConfig Amd64 (Linux Fedora42) 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) - , disableValidate (standardBuilds Amd64 (Linux Fedora38)) + , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora42) releaseConfig)) + , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora42) dwarf) + , disableValidate (standardBuilds Amd64 (Linux Fedora42)) ] where hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage") @@ -1375,7 +1365,7 @@ platform_mapping = Map.map go combined_result , "x86_64-linux-deb11-validate" , "x86_64-linux-deb12-validate" , "x86_64-linux-deb10-validate+debug_info" - , "x86_64-linux-fedora33-release" + , "x86_64-linux-fedora42-release" , "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" , "x86_64-windows-validate" , "aarch64-linux-deb12-validate" @@ -1390,13 +1380,13 @@ platform_mapping = Map.map go combined_result , "nightly-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate" , "nightly-x86_64-linux-alpine3_12-validate+fully_static" , "nightly-x86_64-linux-deb10-validate" - , "nightly-x86_64-linux-fedora33-release" + , "nightly-x86_64-linux-fedora42-release" , "nightly-x86_64-windows-validate" , "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections" , "release-x86_64-linux-deb10-release" , "release-x86_64-linux-deb11-release" , "release-x86_64-linux-deb12-release" - , "release-x86_64-linux-fedora33-release" + , "release-x86_64-linux-fedora42-release" , "release-x86_64-windows-release" ] ===================================== .gitlab/jobs.yaml ===================================== @@ -2942,7 +2942,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-fedora33-release": { + "nightly-x86_64-linux-fedora42-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2953,7 +2953,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2963,14 +2963,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2996,18 +2996,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release", + "TEST_ENV": "x86_64-linux-fedora42-release", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-fedora33-release-hackage": { + "nightly-x86_64-linux-fedora42-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -3018,7 +3016,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3028,14 +3026,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -3061,19 +3059,17 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-for-hackage", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release", + "TEST_ENV": "x86_64-linux-fedora42-release", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-fedora33-validate+debug_info": { + "nightly-x86_64-linux-fedora42-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -3084,7 +3080,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", + "ghc-x86_64-linux-fedora42-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3094,14 +3090,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -3127,18 +3123,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", - "BUILD_FLAVOUR": "validate+debug_info", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate", + "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", + "TEST_ENV": "x86_64-linux-fedora42-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-fedora38-validate": { + "nightly-x86_64-linux-fedora42-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -3149,7 +3143,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-fedora38-validate.tar.xz", + "ghc-x86_64-linux-fedora42-validate+debug_info.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3159,14 +3153,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora38-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -3192,12 +3186,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora38-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate+debug_info", + "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora38-validate", + "TEST_ENV": "x86_64-linux-fedora42-validate+debug_info", "XZ_OPT": "-9" } }, @@ -4814,7 +4808,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-fedora33-release": { + "release-x86_64-linux-fedora42-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4825,7 +4819,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4835,14 +4829,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -4868,19 +4862,17 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release", + "TEST_ENV": "x86_64-linux-fedora42-release", "XZ_OPT": "-9" } }, - "release-x86_64-linux-fedora33-release+debug_info": { + "release-x86_64-linux-fedora42-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4891,7 +4883,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", + "ghc-x86_64-linux-fedora42-release+debug_info.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4901,14 +4893,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -4934,19 +4926,17 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", + "TEST_ENV": "x86_64-linux-fedora42-release+debug_info", "XZ_OPT": "-9" } }, - "release-x86_64-linux-fedora33-release-hackage": { + "release-x86_64-linux-fedora42-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4957,7 +4947,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4967,14 +4957,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -5000,80 +4990,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-for-hackage", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release", - "XZ_OPT": "-9" - } - }, - "release-x86_64-linux-fedora38-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings.txt" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-fedora38-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-fedora38-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", - "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-fedora38-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "IGNORE_PERF_FAILURES": "all", - "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora38-release", + "TEST_ENV": "x86_64-linux-fedora42-release", "XZ_OPT": "-9" } }, @@ -7108,7 +7032,7 @@ "TEST_ENV": "x86_64-linux-deb9-validate" } }, - "x86_64-linux-fedora33-release": { + "x86_64-linux-fedora42-release": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -7119,7 +7043,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -7129,14 +7053,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -7145,7 +7069,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-release(\\s|$).*/)) || (($ONLY_JOBS == null) && ((\"true\" == \"true\")))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -7162,17 +7086,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release" + "TEST_ENV": "x86_64-linux-fedora42-release" } }, - "x86_64-linux-fedora33-release-hackage": { + "x86_64-linux-fedora42-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -7183,7 +7105,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-release.tar.xz", + "ghc-x86_64-linux-fedora42-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -7193,14 +7115,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -7209,7 +7131,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-release(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -7226,18 +7148,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-release", "BUILD_FLAVOUR": "release", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-for-hackage", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-release" + "TEST_ENV": "x86_64-linux-fedora42-release" } }, - "x86_64-linux-fedora33-validate+debug_info": { + "x86_64-linux-fedora42-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -7248,7 +7168,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", + "ghc-x86_64-linux-fedora42-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -7258,14 +7178,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora33-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -7274,7 +7194,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora33-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -7291,17 +7211,15 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", - "BUILD_FLAVOUR": "validate+debug_info", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate", + "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "LLC": "/bin/false", - "OPT": "/bin/false", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info" + "TEST_ENV": "x86_64-linux-fedora42-validate" } }, - "x86_64-linux-fedora38-validate": { + "x86_64-linux-fedora42-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -7312,7 +7230,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-fedora38-validate.tar.xz", + "ghc-x86_64-linux-fedora42-validate+debug_info.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -7322,14 +7240,14 @@ "when": "always" }, "cache": { - "key": "x86_64-linux-fedora38-$CACHE_REV", + "key": "x86_64-linux-fedora42-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora38:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora42:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -7338,7 +7256,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora38-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-fedora42-validate\\+debug_info(\\s|$).*/)) || (($ONLY_JOBS == null) && (\"disabled\" != \"disabled\"))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -7355,12 +7273,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-fedora38-validate", - "BUILD_FLAVOUR": "validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-fedora42-validate+debug_info", + "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-fedora38-validate" + "TEST_ENV": "x86_64-linux-fedora42-validate+debug_info" } }, "x86_64-linux-rocky8-validate": { ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -23,10 +23,8 @@ def job_triple(job_name): 'release-x86_64-linux-ubuntu22_04-release': 'x86_64-ubuntu22_04-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-fedora38-release': 'x86_64-fedora38-linux', - 'release-x86_64-linux-fedora33-release+debug_info': 'x86_64-fedora33-linux-dwarf', - 'release-x86_64-linux-fedora33-release': 'x86_64-fedora33-linux', - 'release-x86_64-linux-fedora27-release': 'x86_64-fedora27-linux', + 'release-x86_64-linux-fedora42-release': 'x86_64-fedora42-linux', + 'release-x86_64-linux-fedora42-release+debug_info': 'x86_64-fedora42-linux-dwarf', 'release-x86_64-linux-deb12-release': 'x86_64-deb12-linux', 'release-x86_64-linux-deb11-release': 'x86_64-deb11-linux', 'release-x86_64-linux-deb10-release+debug_info': 'x86_64-deb10-linux-dwarf', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -200,7 +200,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): ubuntu2204 = mk(ubuntu("22_04")) ubuntu2404 = mk(ubuntu("24_04")) rocky8 = mk(rocky("8")) - fedora33 = mk(fedora(33)) + fedora42 = mk(fedora(42)) darwin_x86 = mk(darwin("x86_64")) darwin_arm64 = mk(darwin("aarch64")) windows = mk(windowsArtifact) @@ -239,11 +239,9 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): , "unknown_versioning": ubuntu2004 } , "Linux_CentOS" : { "( >= 8 && < 9 )" : rocky8 , "unknown_versioning" : rocky8 } - , "Linux_Fedora" : { ">= 33": fedora33 + , "Linux_Fedora" : { ">= 42": fedora42 , "unknown_versioning": rocky8 } - , "Linux_RedHat" : { "< 9": rocky8 - , ">= 9": fedora33 - , "unknown_versioning": fedora33 } + , "Linux_RedHat" : { "unknown_versioning": rocky8 } , "Linux_UnknownLinux" : { "unknown_versioning": rocky8 } , "Darwin" : { "unknown_versioning" : darwin_x86 } , "Windows" : { "unknown_versioning" : windows } ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -58,6 +58,7 @@ module GHC.HsToCore.Monad ( import GHC.Prelude import GHC.Driver.Env +import GHC.Driver.Env.KnotVars import GHC.Driver.DynFlags import GHC.Driver.Ppr import GHC.Driver.Config.Diagnostic @@ -117,7 +118,7 @@ import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict import Data.IORef -import GHC.Driver.Env.KnotVars + import GHC.IO.Unsafe (unsafeInterleaveIO) {- ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -26,6 +26,7 @@ module GHC.Tc.Module ( runTcInteractive, -- Used by GHC API clients (#8878) withTcPlugins, -- Used by GHC API clients (#20499) withHoleFitPlugins, -- Used by GHC API clients (#20499) + withDefaultingPlugins, tcRnLookupName, tcRnGetInfo, tcRnModule, tcRnModuleTcRnM, @@ -53,7 +54,6 @@ import GHC.Driver.DynFlags import GHC.Driver.Config.Diagnostic import GHC.IO.Unsafe ( unsafeInterleaveIO ) -import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) ) import GHC.Tc.Errors.Types import {-# SOURCE #-} GHC.Tc.Gen.Splice ( finishTH, runRemoteModFinalizers ) import GHC.Tc.Gen.HsType @@ -141,7 +141,6 @@ import GHC.Types.Id as Id import GHC.Types.Id.Info( IdDetails(..) ) import GHC.Types.Var.Env import GHC.Types.TypeEnv -import GHC.Types.Unique.FM import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set @@ -212,10 +211,6 @@ tcRnModule hsc_env mod_sum save_rn_syntax (text "Renamer/typechecker"<+>brackets (ppr this_mod)) (const ()) $ initTc hsc_env hsc_src save_rn_syntax this_mod real_loc $ - withTcPlugins hsc_env $ - withDefaultingPlugins hsc_env $ - withHoleFitPlugins hsc_env $ - tcRnModuleTcRnM hsc_env mod_sum parsedModule this_mod | otherwise @@ -3182,72 +3177,11 @@ hasTopUserName x {- ******************************************************************************** -Type Checker Plugins + Running plugins ******************************************************************************** -} -withTcPlugins :: HscEnv -> TcM a -> TcM a -withTcPlugins hsc_env m = - case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of - [] -> m -- Common fast case - plugins -> do - (solvers, rewriters, stops) <- - unzip3 `fmap` mapM start_plugin plugins - let - rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter] - !rewritersUniqFM = sequenceUFMList rewriters - -- The following ensures that tcPluginStop is called even if a type - -- error occurs during compilation (Fix of #10078) - eitherRes <- tryM $ - updGblEnv (\e -> e { tcg_tc_plugin_solvers = solvers - , tcg_tc_plugin_rewriters = rewritersUniqFM }) m - mapM_ runTcPluginM stops - case eitherRes of - Left _ -> failM - Right res -> return res - where - start_plugin (TcPlugin start solve rewrite stop) = - do s <- runTcPluginM start - return (solve s, rewrite s, stop s) - -withDefaultingPlugins :: HscEnv -> TcM a -> TcM a -withDefaultingPlugins hsc_env m = - do case catMaybes $ mapPlugins (hsc_plugins hsc_env) defaultingPlugin of - [] -> m -- Common fast case - plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins - -- This ensures that dePluginStop is called even if a type - -- error occurs during compilation - eitherRes <- tryM $ do - updGblEnv (\e -> e { tcg_defaulting_plugins = plugins }) m - mapM_ runTcPluginM stops - case eitherRes of - Left _ -> failM - Right res -> return res - where - start_plugin (DefaultingPlugin start fill stop) = - do s <- runTcPluginM start - return (fill s, stop s) - -withHoleFitPlugins :: HscEnv -> TcM a -> TcM a -withHoleFitPlugins hsc_env m = - case catMaybes $ mapPlugins (hsc_plugins hsc_env) holeFitPlugin of - [] -> m -- Common fast case - plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins - -- This ensures that hfPluginStop is called even if a type - -- error occurs during compilation. - eitherRes <- tryM $ - updGblEnv (\e -> e { tcg_hf_plugins = plugins }) m - sequence_ stops - case eitherRes of - Left _ -> failM - Right res -> return res - where - start_plugin (HoleFitPluginR init plugin stop) = - do ref <- init - return (plugin ref, stop ref) - - runRenamerPlugin :: TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn) ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -31,6 +31,9 @@ module GHC.Tc.Utils.Monad( updateEps, updateEps_, getHpt, getEpsAndHug, + -- * Initialising TcM plugins + withTcPlugins, withDefaultingPlugins, withHoleFitPlugins, + -- * Arrow scopes newArrowScope, escapeArrowScope, @@ -163,6 +166,7 @@ import GHC.Builtin.Names import GHC.Builtin.Types( zonkAnyTyCon ) import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) ) import GHC.Tc.Types -- Re-export all import GHC.Tc.Types.Constraint import GHC.Tc.Types.CtLoc @@ -183,13 +187,17 @@ import GHC.Unit.Module.Warnings import GHC.Unit.Home.PackageTable import GHC.Core.UsageEnv + +import GHC.Core.Coercion ( isReflCo ) import GHC.Core.Multiplicity import GHC.Core.InstEnv import GHC.Core.FamInstEnv import GHC.Core.Type( mkNumLitTy ) +import GHC.Core.TyCon ( TyCon ) import GHC.Driver.Env import GHC.Driver.Env.KnotVars +import GHC.Driver.Plugins ( Plugin(..), mapPlugins ) import GHC.Driver.Session import GHC.Driver.Config.Diagnostic @@ -226,7 +234,7 @@ import GHC.Types.SrcLoc import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Name.Ppr -import GHC.Types.Unique.FM ( emptyUFM ) +import GHC.Types.Unique.FM ( UniqFM, emptyUFM, sequenceUFMList ) import GHC.Types.Unique.DFM import GHC.Types.Unique.Supply import GHC.Types.Annotations @@ -240,8 +248,6 @@ import Data.IORef import Control.Monad import qualified Data.Map as Map -import GHC.Core.Coercion (isReflCo) - {- ************************************************************************ @@ -263,129 +269,139 @@ initTc :: HscEnv -- (error messages should have been printed already) initTc hsc_env hsc_src keep_rn_syntax mod loc do_this - = do { keep_var <- newIORef emptyNameSet ; - used_gre_var <- newIORef [] ; - th_var <- newIORef False ; - infer_var <- newIORef True ; - infer_reasons_var <- newIORef emptyMessages ; - dfun_n_var <- newIORef emptyOccSet ; - zany_n_var <- newIORef 0 ; - let { type_env_var = hsc_type_env_vars hsc_env }; - - dependent_files_var <- newIORef [] ; - dependent_dirs_var <- newIORef [] ; - static_wc_var <- newIORef emptyWC ; - cc_st_var <- newIORef newCostCentreState ; - th_topdecls_var <- newIORef [] ; - th_foreign_files_var <- newIORef [] ; - th_topnames_var <- newIORef emptyNameSet ; - th_modfinalizers_var <- newIORef [] ; - th_coreplugins_var <- newIORef [] ; - th_state_var <- newIORef Map.empty ; - th_remote_state_var <- newIORef Nothing ; - th_docs_var <- newIORef Map.empty ; - th_needed_deps_var <- newIORef ([], emptyUDFM) ; - next_wrapper_num <- newIORef emptyModuleEnv ; - let { - -- bangs to avoid leaking the env (#19356) - !dflags = hsc_dflags hsc_env ; - !mhome_unit = hsc_home_unit_maybe hsc_env; - !logger = hsc_logger hsc_env ; - - maybe_rn_syntax :: forall a. a -> Maybe a ; - maybe_rn_syntax empty_val - | logHasDumpFlag logger Opt_D_dump_rn_ast = Just empty_val - - | gopt Opt_WriteHie dflags = Just empty_val - - -- We want to serialize the documentation in the .hi-files, - -- and need to extract it from the renamed syntax first. - -- See 'GHC.HsToCore.Docs.extractDocs'. - | gopt Opt_Haddock dflags = Just empty_val - - | keep_rn_syntax = Just empty_val - | otherwise = Nothing ; - - gbl_env = TcGblEnv { - tcg_th_topdecls = th_topdecls_var, - tcg_th_foreign_files = th_foreign_files_var, - tcg_th_topnames = th_topnames_var, - tcg_th_modfinalizers = th_modfinalizers_var, - tcg_th_coreplugins = th_coreplugins_var, - tcg_th_state = th_state_var, - tcg_th_remote_state = th_remote_state_var, - tcg_th_docs = th_docs_var, - - tcg_mod = mod, - tcg_semantic_mod = homeModuleInstantiation mhome_unit mod, - tcg_src = hsc_src, - tcg_rdr_env = emptyGlobalRdrEnv, - tcg_fix_env = emptyNameEnv, - tcg_default = emptyDefaultEnv, - tcg_default_exports = emptyDefaultEnv, - tcg_type_env = emptyNameEnv, - tcg_type_env_var = type_env_var, - tcg_inst_env = emptyInstEnv, - tcg_fam_inst_env = emptyFamInstEnv, - tcg_ann_env = emptyAnnEnv, - tcg_complete_match_env = [], - tcg_th_used = th_var, - tcg_th_needed_deps = th_needed_deps_var, - tcg_exports = [], - tcg_imports = emptyImportAvails, - tcg_import_decls = [], - tcg_used_gres = used_gre_var, - tcg_dus = emptyDUs, - - tcg_rn_imports = [], - tcg_rn_exports = - if hsc_src == HsigFile - -- Always retain renamed syntax, so that we can give - -- better errors. (TODO: how?) - then Just [] - else maybe_rn_syntax [], - tcg_rn_decls = maybe_rn_syntax emptyRnGroup, - tcg_tr_module = Nothing, - tcg_binds = emptyLHsBinds, - tcg_imp_specs = [], - tcg_sigs = emptyNameSet, - tcg_ksigs = emptyNameSet, - tcg_ev_binds = emptyBag, - tcg_warns = emptyWarn, - tcg_anns = [], - tcg_tcs = [], - tcg_insts = [], - tcg_fam_insts = [], - tcg_rules = [], - tcg_fords = [], - tcg_patsyns = [], - tcg_merged = [], - tcg_dfun_n = dfun_n_var, - tcg_zany_n = zany_n_var, - tcg_keep = keep_var, - tcg_hdr_info = (Nothing,Nothing), - tcg_main = Nothing, - tcg_self_boot = NoSelfBoot, - tcg_safe_infer = infer_var, - tcg_safe_infer_reasons = infer_reasons_var, - tcg_dependent_files = dependent_files_var, - tcg_dependent_dirs = dependent_dirs_var, - tcg_tc_plugin_solvers = [], - tcg_tc_plugin_rewriters = emptyUFM, - tcg_defaulting_plugins = [], - tcg_hf_plugins = [], - tcg_top_loc = loc, - tcg_static_wc = static_wc_var, - tcg_complete_matches = [], - tcg_cc_st = cc_st_var, - tcg_next_wrapper_num = next_wrapper_num - } ; - } ; + = do { gbl_env <- initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc -- OK, here's the business end! - initTcWithGbl hsc_env gbl_env loc do_this + ; initTcWithGbl hsc_env gbl_env loc $ + + -- Make sure to initialise all TcM plugins from the ambient HscEnv. + -- + -- This ensures that all callers of 'initTc' enable plugins (#26395). + withTcPlugins hsc_env $ + withDefaultingPlugins hsc_env $ + withHoleFitPlugins hsc_env $ + + do_this } +-- | Create an empty 'TcGblEnv'. +initTcGblEnv :: HscEnv -> HscSource -> Bool -> Module -> RealSrcSpan -> IO TcGblEnv +initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc = + do { keep_var <- newIORef emptyNameSet + ; used_gre_var <- newIORef [] + ; th_var <- newIORef False + ; infer_var <- newIORef True + ; infer_reasons_var <- newIORef emptyMessages + ; dfun_n_var <- newIORef emptyOccSet + ; zany_n_var <- newIORef 0 + ; dependent_files_var <- newIORef [] + ; dependent_dirs_var <- newIORef [] + ; static_wc_var <- newIORef emptyWC + ; cc_st_var <- newIORef newCostCentreState + ; th_topdecls_var <- newIORef [] + ; th_foreign_files_var <- newIORef [] + ; th_topnames_var <- newIORef emptyNameSet + ; th_modfinalizers_var <- newIORef [] + ; th_coreplugins_var <- newIORef [] + ; th_state_var <- newIORef Map.empty + ; th_remote_state_var <- newIORef Nothing + ; th_docs_var <- newIORef Map.empty + ; th_needed_deps_var <- newIORef ([], emptyUDFM) + ; next_wrapper_num <- newIORef emptyModuleEnv + ; let + -- bangs to avoid leaking the env (#19356) + !dflags = hsc_dflags hsc_env + !mhome_unit = hsc_home_unit_maybe hsc_env + !logger = hsc_logger hsc_env + + maybe_rn_syntax :: forall a. a -> Maybe a ; + maybe_rn_syntax empty_val + | logHasDumpFlag logger Opt_D_dump_rn_ast = Just empty_val + + | gopt Opt_WriteHie dflags = Just empty_val + + -- We want to serialize the documentation in the .hi-files, + -- and need to extract it from the renamed syntax first. + -- See 'GHC.HsToCore.Docs.extractDocs'. + | gopt Opt_Haddock dflags = Just empty_val + + | keep_rn_syntax = Just empty_val + | otherwise = Nothing ; + + ; return $ TcGblEnv + { tcg_th_topdecls = th_topdecls_var + , tcg_th_foreign_files = th_foreign_files_var + , tcg_th_topnames = th_topnames_var + , tcg_th_modfinalizers = th_modfinalizers_var + , tcg_th_coreplugins = th_coreplugins_var + , tcg_th_state = th_state_var + , tcg_th_remote_state = th_remote_state_var + , tcg_th_docs = th_docs_var + + , tcg_mod = mod + , tcg_semantic_mod = homeModuleInstantiation mhome_unit mod + , tcg_src = hsc_src + , tcg_rdr_env = emptyGlobalRdrEnv + , tcg_fix_env = emptyNameEnv + , tcg_default = emptyDefaultEnv + , tcg_default_exports = emptyDefaultEnv + , tcg_type_env = emptyNameEnv + , tcg_type_env_var = hsc_type_env_vars hsc_env + , tcg_inst_env = emptyInstEnv + , tcg_fam_inst_env = emptyFamInstEnv + , tcg_ann_env = emptyAnnEnv + , tcg_complete_match_env = [] + , tcg_th_used = th_var + , tcg_th_needed_deps = th_needed_deps_var + , tcg_exports = [] + , tcg_imports = emptyImportAvails + , tcg_import_decls = [] + , tcg_used_gres = used_gre_var + , tcg_dus = emptyDUs + + , tcg_rn_imports = [] + , tcg_rn_exports = if hsc_src == HsigFile + -- Always retain renamed syntax, so that we can give + -- better errors. (TODO: how?) + then Just [] + else maybe_rn_syntax [] + , tcg_rn_decls = maybe_rn_syntax emptyRnGroup + , tcg_tr_module = Nothing + , tcg_binds = emptyLHsBinds + , tcg_imp_specs = [] + , tcg_sigs = emptyNameSet + , tcg_ksigs = emptyNameSet + , tcg_ev_binds = emptyBag + , tcg_warns = emptyWarn + , tcg_anns = [] + , tcg_tcs = [] + , tcg_insts = [] + , tcg_fam_insts = [] + , tcg_rules = [] + , tcg_fords = [] + , tcg_patsyns = [] + , tcg_merged = [] + , tcg_dfun_n = dfun_n_var + , tcg_zany_n = zany_n_var + , tcg_keep = keep_var + , tcg_hdr_info = (Nothing,Nothing) + , tcg_main = Nothing + , tcg_self_boot = NoSelfBoot + , tcg_safe_infer = infer_var + , tcg_safe_infer_reasons = infer_reasons_var + , tcg_dependent_files = dependent_files_var + , tcg_dependent_dirs = dependent_dirs_var + , tcg_tc_plugin_solvers = [] + , tcg_tc_plugin_rewriters = emptyUFM + , tcg_defaulting_plugins = [] + , tcg_hf_plugins = [] + , tcg_top_loc = loc + , tcg_static_wc = static_wc_var + , tcg_complete_matches = [] + , tcg_cc_st = cc_st_var + , tcg_next_wrapper_num = next_wrapper_num + } } + -- | Run a 'TcM' action in the context of an existing 'GblEnv'. initTcWithGbl :: HscEnv -> TcGblEnv @@ -686,6 +702,83 @@ withIfaceErr ctx do_this = do liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) Succeeded result -> return result +{- +************************************************************************ +* * + Initialising plugins for TcM +* * +************************************************************************ +-} + +-- | Initialise typechecker plugins, run the inner action, then stop +-- the typechecker plugins. +withTcPlugins :: HscEnv -> TcM a -> TcM a +withTcPlugins hsc_env m = + case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of + [] -> m -- Common fast case + plugins -> do + (solvers, rewriters, stops) <- + unzip3 `fmap` mapM start_plugin plugins + let + rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter] + !rewritersUniqFM = sequenceUFMList rewriters + -- The following ensures that tcPluginStop is called even if a type + -- error occurs during compilation (Fix of #10078) + eitherRes <- tryM $ + updGblEnv (\e -> e { tcg_tc_plugin_solvers = solvers + , tcg_tc_plugin_rewriters = rewritersUniqFM }) + m + mapM_ runTcPluginM stops + case eitherRes of + Left _ -> failM + Right res -> return res + where + start_plugin (TcPlugin start solve rewrite stop) = + do s <- runTcPluginM start + return (solve s, rewrite s, stop s) + +-- | Initialise defaulting plugins, run the inner action, then stop +-- the defaulting plugins. +withDefaultingPlugins :: HscEnv -> TcM a -> TcM a +withDefaultingPlugins hsc_env m = + do case catMaybes $ mapPlugins (hsc_plugins hsc_env) defaultingPlugin of + [] -> m -- Common fast case + plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins + -- This ensures that dePluginStop is called even if a type + -- error occurs during compilation + eitherRes <- tryM $ do + updGblEnv (\e -> e { tcg_defaulting_plugins = plugins }) + m + mapM_ runTcPluginM stops + case eitherRes of + Left _ -> failM + Right res -> return res + where + start_plugin (DefaultingPlugin start fill stop) = + do s <- runTcPluginM start + return (fill s, stop s) + +-- | Initialise hole fit plugins, run the inner action, then stop +-- the hole fit plugins. +withHoleFitPlugins :: HscEnv -> TcM a -> TcM a +withHoleFitPlugins hsc_env m = + case catMaybes $ mapPlugins (hsc_plugins hsc_env) holeFitPlugin of + [] -> m -- Common fast case + plugins -> do (plugins,stops) <- mapAndUnzipM start_plugin plugins + -- This ensures that hfPluginStop is called even if a type + -- error occurs during compilation. + eitherRes <- tryM $ + updGblEnv (\e -> e { tcg_hf_plugins = plugins }) + m + sequence_ stops + case eitherRes of + Left _ -> failM + Right res -> return res + where + start_plugin (HoleFitPluginR init plugin stop) = + do ref <- init + return (plugin ref, stop ref) + {- ************************************************************************ * * ===================================== m4/prep_target_file.m4 ===================================== @@ -78,22 +78,6 @@ AC_DEFUN([PREP_MAYBE_PROGRAM],[ AC_SUBST([$1MaybeProg]) ]) -# PREP_MAYBE_LIBRARY -# ========================= -# -# Introduce a substitution [$1MaybeProg] with -# * Nothing, if $$1 is empty or "NO" -# * Just the library otherwise -AC_DEFUN([PREP_MAYBE_LIBRARY],[ - if test -z "$$1" || test "$$1" = "NO"; then - $1MaybeLibrary=Nothing - else - PREP_LIST([$2]) - $1MaybeLibrary="Just (Library { libName = \"$2\", includePath = \"$3\", libraryPath = \"$4\" })" - fi - AC_SUBST([$1MaybeLibrary]) -]) - # PREP_MAYBE_STRING # ========================= # @@ -111,6 +95,24 @@ AC_DEFUN([PREP_MAYBE_STRING],[ AC_SUBST([$1MaybeStr]) ]) +# PREP_MAYBE_LIBRARY +# ========================= +# +# Introduce a substitution [$1MaybeProg] with +# * Nothing, if $$1 is empty or "NO" +# * Just the library otherwise +AC_DEFUN([PREP_MAYBE_LIBRARY],[ + if test -z "$$1" || test "$$1" = "NO"; then + $1MaybeLibrary=Nothing + else + PREP_LIST([$2]) + PREP_MAYBE_STRING([$3]) + PREP_MAYBE_STRING([$4]) + $1MaybeLibrary="Just Library { libName = \"$2\", includePath = $$3MaybeStr, libraryPath = $$4MaybeStr }" + fi + AC_SUBST([$1MaybeLibrary]) +]) + # PREP_BOOLEAN # ============ # @@ -195,10 +197,7 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([CONF_CPP_OPTS_STAGE2]) PREP_LIST([CONF_CXX_OPTS_STAGE2]) PREP_LIST([CONF_CC_OPTS_STAGE2]) - - PREP_MAYBE_STRING([LibdwIncludeDir]) - PREP_MAYBE_STRING([LibdwLibDir]) - PREP_MAYBE_LIBRARY([UseLibdw], [dw], [$LibdwIncludeDirMaybeStr], [$LibdwLibDirMaybeStr]) + PREP_MAYBE_LIBRARY([UseLibdw], [dw], [LibdwIncludeDir], [LibdwLibDir]) dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -36,7 +36,7 @@ T13233_orig: T14999: '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -g -c T14999.cmm -o T14999.o - gdb --batch -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]' + gdb --batch -ex 'set disassembly-flavor intel' -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]' LANG=C readelf --debug-dump=frames-interp T14999.o | tr -s '[[:blank:]\n]' T15196: ===================================== testsuite/tests/codeGen/should_compile/T14999.stdout ===================================== @@ -1,6 +1,6 @@ Dump of assembler code for function stg_catch_frame_info: - 0x0000000000000010 <+0>: add $0x18,%rbp - 0x0000000000000014 <+4>: jmpq *0x0(%rbp) + 0x0000000000000010 <+1>: add rbp,0x18 + 0x0000000000000014 <+5>: jmp QWORD PTR [rbp+0x0] End of assembler dump. Contents of the .debug_frame section: 00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16 ===================================== testsuite/tests/tcplugins/T26395.hs ===================================== @@ -0,0 +1,51 @@ + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UnliftedDatatypes #-} + +{-# OPTIONS_GHC -fplugin=T26395_Plugin #-} + +{-# OPTIONS_GHC -Wincomplete-patterns #-} +{-# OPTIONS_GHC -Winaccessible-code #-} +{-# OPTIONS_GHC -Woverlapping-patterns #-} + +module T26395 where + +import Data.Kind +import GHC.TypeNats +import GHC.Exts ( UnliftedType ) + +-- This test verifies that typechecker plugins are enabled +-- when we run the solver for pattern-match checking. + +type Peano :: Nat -> UnliftedType +data Peano n where + Z :: Peano 0 + S :: Peano n -> Peano (1 + n) + +test1 :: Peano n -> Peano n -> Int +test1 Z Z = 0 +test1 (S n) (S m) = 1 + test1 n m + +{- +The following test doesn't work properly due to #26401: +the pattern-match checker reports a missing equation + + Z (S _) _ + +but there is no invocation of the solver of the form + + [G] n ~ 0 + [G] m ~ 1 + m1 + [G] (n-m) ~ m2 + +for which we could report the Givens as contradictory. + +test2 :: Peano n -> Peano m -> Peano (n - m) -> Int +test2 Z Z Z = 0 +test2 (S _) (S _) _ = 1 +test2 (S _) Z (S _) = 2 +-} ===================================== testsuite/tests/tcplugins/T26395.stderr ===================================== @@ -0,0 +1,2 @@ +[1 of 2] Compiling T26395_Plugin ( T26395_Plugin.hs, T26395_Plugin.o ) +[2 of 2] Compiling T26395 ( T26395.hs, T26395.o ) ===================================== testsuite/tests/tcplugins/T26395_Plugin.hs ===================================== @@ -0,0 +1,208 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wall -Wno-orphans #-} + +module T26395_Plugin where + +-- base +import Prelude hiding ( (<>) ) +import qualified Data.Semigroup as S +import Data.List ( partition ) +import Data.Maybe +import GHC.TypeNats + +-- ghc +import GHC.Builtin.Types.Literals +import GHC.Core.Predicate +import GHC.Core.TyCo.Rep +import GHC.Plugins +import GHC.Tc.Plugin +import GHC.Tc.Types +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.Evidence +import GHC.Tc.Utils.TcType +import GHC.Types.Unique.Map + +-------------------------------------------------------------------------------- + +plugin :: Plugin +plugin = + defaultPlugin + { pluginRecompile = purePlugin + , tcPlugin = \ _-> Just $ + TcPlugin + { tcPluginInit = pure () + , tcPluginSolve = \ _ -> solve + , tcPluginRewrite = \ _ -> emptyUFM + , tcPluginStop = \ _ -> pure () + } + } + +solve :: EvBindsVar -> [Ct] -> [Ct] -> TcPluginM TcPluginSolveResult +solve _ givens wanteds + -- This plugin only reports inconsistencies among Given constraints. + | not $ null wanteds + = pure $ TcPluginOk [] [] + | otherwise + = do { let givenLinearExprs = mapMaybe linearExprCt_maybe givens + sols = solutions givenLinearExprs + + ; tcPluginTrace "solveLinearExprs" $ + vcat [ text "givens:" <+> ppr givens + , text "linExprs:" <+> ppr givenLinearExprs + , text "sols:" <+> ppr (take 1 sols) + ] + ; return $ + if null sols + then TcPluginContradiction givens + else TcPluginOk [] [] + } + +data LinearExpr = + LinearExpr + { constant :: Integer + , coeffs :: UniqMap TyVar Integer + } +instance Semigroup LinearExpr where + LinearExpr c xs <> LinearExpr d ys = + LinearExpr ( c + d ) ( plusMaybeUniqMap_C comb xs ys ) + where + comb a1 a2 = + let a = a1 + a2 + in if a == 0 + then Nothing + else Just a + +instance Monoid LinearExpr where + mempty = LinearExpr 0 emptyUniqMap + +mapLinearExpr :: (Integer -> Integer) -> LinearExpr -> LinearExpr +mapLinearExpr f (LinearExpr c xs) = LinearExpr (f c) (mapUniqMap f xs) + +minusLinearExpr :: LinearExpr -> LinearExpr -> LinearExpr +minusLinearExpr a b = a S.<> mapLinearExpr negate b + +instance Outputable LinearExpr where + ppr ( LinearExpr c xs ) = + hcat $ punctuate ( text " + " ) $ + ( ppr c : map ppr_var ( nonDetUniqMapToList xs ) ) + where + ppr_var ( tv, i ) + | i == 1 + = ppr tv + | i < 0 + = parens ( text "-" <> ppr (abs i) ) <> text "*" <> ppr tv + | otherwise + = ppr i <> text "*" <> ppr tv + +maxCoeff :: LinearExpr -> Double +maxCoeff ( LinearExpr c xs ) = + maximum ( map fromInteger ( c : nonDetEltsUniqMap xs ) ) + + +linearExprCt_maybe :: Ct -> Maybe LinearExpr +linearExprCt_maybe ct = + case classifyPredType (ctPred ct) of + EqPred NomEq lhs rhs + | all isNaturalTy [ typeKind lhs, typeKind rhs ] + , Just e1 <- linearExprTy_maybe lhs + , Just e2 <- linearExprTy_maybe rhs + -> Just $ e1 `minusLinearExpr` e2 + _ -> Nothing + +isNat :: Type -> Maybe Integer +isNat ty + | Just (NumTyLit n) <- isLitTy ty + = Just n + | otherwise + = Nothing + +linearExprTy_maybe :: Type -> Maybe LinearExpr +linearExprTy_maybe ty + | Just n <- isNat ty + = Just $ LinearExpr n emptyUniqMap + | Just (tc, args) <- splitTyConApp_maybe ty + = if | tc == typeNatAddTyCon + , [x, y] <- args + , Just e1 <- linearExprTy_maybe x + , Just e2 <- linearExprTy_maybe y + -> Just $ e1 S.<> e2 + | tc == typeNatSubTyCon + , [x,y] <- args + , Just e1 <- linearExprTy_maybe x + , Just e2 <- linearExprTy_maybe y + -> Just $ e1 `minusLinearExpr` e2 + | tc == typeNatMulTyCon + , [x, y] <- args + -> + if | Just ( LinearExpr n xs ) <- linearExprTy_maybe x + , isNullUniqMap xs + , Just e <- linearExprTy_maybe y + -> Just $ + if n == 0 + then mempty + else mapLinearExpr (n *) e + | Just ( LinearExpr n ys ) <- linearExprTy_maybe y + , isNullUniqMap ys + , Just e <- linearExprTy_maybe x + -> Just $ + if n == 0 + then mempty + else mapLinearExpr (fromIntegral n *) e + | otherwise + -> Nothing + | otherwise + -> Nothing + | Just tv <- getTyVar_maybe ty + = Just $ LinearExpr 0 ( unitUniqMap tv 1 ) + | otherwise + = Nothing + +-- Brute force algorithm to check whether a system of Diophantine +-- linear equations is solvable in natural numbers. +solutions :: [ LinearExpr ] -> [ UniqMap TyVar Natural ] +solutions eqs = + let + (constEqs, realEqs) = partition (isNullUniqMap . coeffs) eqs + d = length realEqs + fvs = nonDetKeysUniqMap $ plusUniqMapList ( map coeffs realEqs ) + in + if | any ( ( /= 0 ) . evalLinearExpr emptyUniqMap ) constEqs + -> [] + | d == 0 + -> [ emptyUniqMap ] + | otherwise + -> + let + m = maximum $ map maxCoeff realEqs + hadamardBound = sqrt ( fromIntegral $ d ^ d ) * m ^ d + tests = mkAssignments ( floor hadamardBound ) fvs + in + filter ( \ test -> isSolution test realEqs ) tests + + +mkAssignments :: Natural -> [ TyVar ] -> [ UniqMap TyVar Natural ] +mkAssignments _ [] = [ emptyUniqMap ] +mkAssignments b (v : vs) = + [ addToUniqMap rest v n + | n <- [ 0 .. b ] + , rest <- mkAssignments b vs + ] + +isSolution :: UniqMap TyVar Natural -> [ LinearExpr ] -> Bool +isSolution assig = + all ( \ expr -> evalLinearExpr assig expr == 0 ) + +evalLinearExpr :: UniqMap TyVar Natural -> LinearExpr -> Integer +evalLinearExpr vals ( LinearExpr c xs ) = nonDetFoldUniqMap aux c xs + where + aux ( tv, coeff ) !acc = acc + coeff * val + where + val :: Integer + val = case lookupUniqMap vals tv of + Nothing -> pprPanic "evalLinearExpr: missing tv" (ppr tv) + Just v -> fromIntegral v ===================================== testsuite/tests/tcplugins/all.T ===================================== @@ -110,6 +110,19 @@ test('TcPlugin_CtId' , '-dynamic -package ghc' if have_dynamic() else '-package ghc' ] ) +# Checks that we run type-checker plugins for pattern-match warnings. +test('T26395' + , [ extra_files( + [ 'T26395_Plugin.hs' + , 'T26395.hs' + ]) + , req_th + ] + , multimod_compile + , [ 'T26395.hs' + , '-dynamic -package ghc' if have_dynamic() else '-package ghc' ] + ) + test('T11462', [js_broken(22261), req_th, req_plugins], multi_compile, [None, [('T11462_Plugin.hs', '-package ghc'), ('T11462.hs', '')], '-dynamic' if have_dynamic() else '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a35b4ee765a3f8189beb9a9ffe0775c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a35b4ee765a3f8189beb9a9ffe0775c... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Marge Bot (＠marge-bot)