GitLab

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

a0e7e8a8

by sheaf at 2025-09-18T19:25:19-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

a35b4ee7

by Cheng Shao at 2025-09-18T19:25:19-04:00

rel-eng: update fedora image to 42

This patch is a part of #25876 and updates fedora image to 42.

12 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
+ 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
 . The fetch-gitlab release utility pulls release artifacts from the
 . The ghc-head-from script downloads release artifacts based on a pipeline change.
 . 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)
++
  {-
  ************************************************************************
  *                                                                      *

testsuite/tests/tcplugins/T26395.hs

++
 +{-# 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

	1	+[1 of 2] Compiling T26395_Plugin ( T26395_Plugin.hs, T26395_Plugin.o )
	2	+[2 of 2] Compiling T26395 ( T26395.hs, T26395.o )

testsuite/tests/tcplugins/T26395_Plugin.hs

 +{-# 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 ''])