.gitignore

@@ -166,6 +166,7 @@ _darcs/
 /libraries/ghc-boot/ghc-boot.cabal
 /libraries/ghc-boot-th/GNUmakefile
 /libraries/ghc-boot-th/ghc-boot-th.cabal
+/libraries/ghc-boot-th-next/ghc-boot-th-next.cabal
 /libraries/ghc-boot-th/ghc.mk
 /libraries/ghc-heap/ghc-heap.cabal
 /libraries/ghci/GNUmakefile
@@ -182,6 +183,7 @@ _darcs/
 /libraries/synopsis.png
 /libraries/stamp/
 /libraries/template-haskell/template-haskell.cabal
+/libraries/template-haskell-next/template-haskell-next.cabal
 /linter.log
 /mk/are-validating.mk
 /mk/build.mk

.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: a9297a370025101b479cfd4977f8f910814e03ab
+  DOCKER_REV: 064e90c26dffe5709bd5b87dbd211b9a8b21fc5b
 
   # Sequential version number of all cached things.
   # Bump to invalidate GitLab CI cache.
@@ -557,12 +557,17 @@ doc-tarball:
     LINUX_BINDIST: "ghc-x86_64-linux-deb10.tar.xz"
     WINDOWS_BINDIST: "ghc-x86_64-windows.tar.xz"
   artifacts:
+    expose_as: "Documentation Preview"
     paths:
       - haddock.html.tar.xz
+      - docs/haddock/
       - libraries.html.tar.xz
+      - docs/libraries/
       - users_guide.html.tar.xz
-      - index.html
-      - "*.pdf"
+      - docs/users_guide/
+      - docs/index.html
+      - Haddock.pdf
+      - users_guide.pdf
   script:
     - |
       mv "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz" "$LINUX_BINDIST" \
@@ -582,8 +587,8 @@ doc-tarball:
       fi
     - rm -Rf docs
     - bash -ex distrib/mkDocs/mkDocs $LINUX_BINDIST $WINDOWS_BINDIST
+    - mv docs/*.tar.xz docs/*.pdf .
     - ls -lh
-    - mv docs/*.tar.xz docs/index.html .
 
 hackage-doc-tarball:
   stage: packaging

.gitlab/generate-ci/gen_ci.hs

@@ -107,6 +107,7 @@ data Opsys
 data LinuxDistro
   = Debian12
   | Debian11
+  | Debian11Js
   | Debian10
   | Debian9
   | Fedora33
@@ -285,12 +286,13 @@ tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use
 -- These names are used to find the docker image so they have to match what is
 -- in the docker registry.
 distroName :: LinuxDistro -> String
-distroName Debian12  = "deb12"
-distroName Debian11  = "deb11"
+distroName Debian12   = "deb12"
+distroName Debian11   = "deb11"
+distroName Debian11Js = "deb11-emsdk-closure"
 distroName Debian10   = "deb10"
-distroName Debian9   = "deb9"
-distroName Fedora33  = "fedora33"
-distroName Fedora38  = "fedora38"
+distroName Debian9    = "deb9"
+distroName Fedora33   = "fedora33"
+distroName Fedora38   = "fedora38"
 distroName Ubuntu1804 = "ubuntu18_04"
 distroName Ubuntu2004 = "ubuntu20_04"
 distroName Centos7    = "centos7"
@@ -339,7 +341,7 @@ flavourString (Flavour base trans) = base_string base ++ concatMap (("+" ++) . f
     flavour_string Llvm = "llvm"
     flavour_string Dwarf = "debug_info"
     flavour_string FullyStatic = "fully_static"
-    flavour_string ThreadSanitiser = "thread_sanitizer"
+    flavour_string ThreadSanitiser = "thread_sanitizer_cmm"
     flavour_string NoSplitSections = "no_split_sections"
     flavour_string BootNonmovingGc = "boot_nonmoving_gc"
 
@@ -969,9 +971,9 @@ job_groups =
      , validateBuilds Amd64 (Linux Debian10) nativeInt
      , validateBuilds Amd64 (Linux Debian10) unreg
      , fastCI (validateBuilds Amd64 (Linux Debian10) debug)
-     , -- Nightly allowed to fail: #22520
+     , -- More work is needed to address TSAN failures: #22520
        modifyNightlyJobs allowFailure
-         (modifyValidateJobs manual tsan_jobs)
+         (modifyValidateJobs (allowFailure . manual) tsan_jobs)
      , -- Nightly allowed to fail: #22343
        modifyNightlyJobs allowFailure
         (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc))
@@ -995,7 +997,6 @@ job_groups =
      , fastCI (standardBuildsWithConfig Amd64 Windows vanilla)
      , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt)
      , addValidateRule TestPrimops (standardBuilds Amd64 Darwin)
-     , allowFailureGroup (onlyRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla))
      , fastCI (standardBuilds AArch64 Darwin)
      , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla))
      , disableValidate (standardBuildsWithConfig AArch64 (Linux Debian11) (splitSectionsBroken vanilla))
@@ -1010,7 +1011,7 @@ job_groups =
      , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) staticNativeInt)))
      , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing)
 
-     , addValidateRule JSBackend (validateBuilds Amd64 (Linux Debian11) javascriptConfig)
+     , addValidateRule JSBackend (validateBuilds Amd64 (Linux Debian11Js) javascriptConfig)
 
      , make_wasm_jobs wasm_build_config
      , modifyValidateJobs manual $
@@ -1039,7 +1040,7 @@ job_groups =
          -- Haddock is large enough to make TSAN choke without massive quantities of
          -- memory.
         . addVariable "HADRIAN_ARGS" "--docs=none") $
-      validateBuilds Amd64 (Linux Debian10) tsan
+      validateBuilds Amd64 (Linux Debian12) tsan
 
     make_wasm_jobs cfg =
       modifyJobs
@@ -1083,6 +1084,7 @@ platform_mapping = Map.map go combined_result
                 , "nightly-x86_64-linux-deb11-validate"
                 , "nightly-x86_64-linux-deb12-validate"
                 , "x86_64-linux-alpine3_18-wasm-cross_wasm32-wasi-release+fully_static"
+                , "x86_64-linux-deb12-validate+thread_sanitizer_cmm"
                 , "nightly-aarch64-linux-deb10-validate"
                 , "nightly-x86_64-linux-alpine3_12-validate"
                 , "nightly-x86_64-linux-deb10-validate"

.gitlab/jobs.yaml

@@ -695,70 +695,6 @@
       "ac_cv_func_utimensat": "no"
     }
   },
-  "nightly-x86_64-freebsd13-validate": {
-    "after_script": [
-      ".gitlab/ci.sh save_cache",
-      ".gitlab/ci.sh save_test_output",
-      ".gitlab/ci.sh clean",
-      "cat ci_timings"
-    ],
-    "allow_failure": true,
-    "artifacts": {
-      "expire_in": "8 weeks",
-      "paths": [
-        "ghc-x86_64-freebsd13-validate.tar.xz",
-        "junit.xml",
-        "unexpected-test-output.tar.gz"
-      ],
-      "reports": {
-        "junit": "junit.xml"
-      },
-      "when": "always"
-    },
-    "cache": {
-      "key": "x86_64-freebsd13-$CACHE_REV",
-      "paths": [
-        "cabal-cache",
-        "toolchain"
-      ]
-    },
-    "dependencies": [],
-    "image": null,
-    "needs": [
-      {
-        "artifacts": false,
-        "job": "hadrian-ghc-in-ghci"
-      }
-    ],
-    "rules": [
-      {
-        "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)",
-        "when": "on_success"
-      }
-    ],
-    "script": [
-      ".gitlab/ci.sh setup",
-      ".gitlab/ci.sh configure",
-      ".gitlab/ci.sh build_hadrian",
-      ".gitlab/ci.sh test_hadrian"
-    ],
-    "stage": "full-build",
-    "tags": [
-      "x86_64-freebsd13"
-    ],
-    "variables": {
-      "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate",
-      "BUILD_FLAVOUR": "validate",
-      "CABAL_INSTALL_VERSION": "3.10.2.0",
-      "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check",
-      "GHC_VERSION": "9.6.4",
-      "HADRIAN_ARGS": "--docs=no-sphinx",
-      "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-freebsd13-validate",
-      "XZ_OPT": "-9"
-    }
-  },
   "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
@@ -1644,18 +1580,18 @@
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb10-validate+thread_sanitizer": {
+  "nightly-x86_64-linux-deb10-zstd-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
       ".gitlab/ci.sh clean",
       "cat ci_timings"
     ],
-    "allow_failure": true,
+    "allow_failure": false,
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz",
+        "ghc-x86_64-linux-deb10-zstd-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1698,17 +1634,15 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer",
-      "BUILD_FLAVOUR": "validate+thread_sanitizer",
-      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
-      "HADRIAN_ARGS": "--docs=none",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate",
+      "BUILD_FLAVOUR": "validate",
+      "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer",
-      "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions",
+      "TEST_ENV": "x86_64-linux-deb10-zstd-validate",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb10-zstd-validate": {
+  "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1719,7 +1653,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb10-zstd-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1729,14 +1663,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb10-$CACHE_REV",
+      "key": "x86_64-linux-deb11-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -1762,15 +1696,17 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
       "BUILD_FLAVOUR": "validate",
-      "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check",
+      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+      "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
+      "CROSS_TARGET": "aarch64-linux-gnu",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb10-zstd-validate",
+      "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
+  "nightly-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1781,7 +1717,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1791,14 +1727,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb11-emsdk-closure-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11-emsdk-closure:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -1823,18 +1759,19 @@
       "x86_64-linux"
     ],
     "variables": {
-      "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+      "BIGNUM_BACKEND": "native",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "BUILD_FLAVOUR": "validate",
       "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
-      "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
-      "CROSS_TARGET": "aarch64-linux-gnu",
+      "CONFIGURE_WRAPPER": "emconfigure",
+      "CROSS_EMULATOR": "js-emulator",
+      "CROSS_TARGET": "javascript-unknown-ghcjs",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+      "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": {
+  "nightly-x86_64-linux-deb11-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1845,7 +1782,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1887,19 +1824,16 @@
       "x86_64-linux"
     ],
     "variables": {
-      "BIGNUM_BACKEND": "native",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
+      "BIGNUM_BACKEND": "gmp",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate",
       "BUILD_FLAVOUR": "validate",
-      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
-      "CONFIGURE_WRAPPER": "emconfigure",
-      "CROSS_EMULATOR": "js-emulator",
-      "CROSS_TARGET": "javascript-unknown-ghcjs",
+      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
+      "TEST_ENV": "x86_64-linux-deb11-validate",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb11-validate": {
+  "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1910,7 +1844,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1953,15 +1887,15 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate",
-      "BUILD_FLAVOUR": "validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc",
+      "BUILD_FLAVOUR": "validate+boot_nonmoving_gc",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
-      "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-validate",
+      "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity",
+      "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": {
+  "nightly-x86_64-linux-deb12-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1972,7 +1906,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz",
+        "ghc-x86_64-linux-deb12-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1982,14 +1916,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb12-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -2015,15 +1949,15 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc",
-      "BUILD_FLAVOUR": "validate+boot_nonmoving_gc",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate",
+      "BUILD_FLAVOUR": "validate",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
-      "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity",
-      "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc",
+      "RUNTEST_ARGS": "",
+      "TEST_ENV": "x86_64-linux-deb12-validate",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb12-validate": {
+  "nightly-x86_64-linux-deb12-validate+llvm": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -2034,7 +1968,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb12-validate.tar.xz",
+        "ghc-x86_64-linux-deb12-validate+llvm.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -2077,26 +2011,26 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate",
-      "BUILD_FLAVOUR": "validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm",
+      "BUILD_FLAVOUR": "validate+llvm",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb12-validate",
+      "TEST_ENV": "x86_64-linux-deb12-validate+llvm",
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb12-validate+llvm": {
+  "nightly-x86_64-linux-deb12-validate+thread_sanitizer_cmm": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
       ".gitlab/ci.sh clean",
       "cat ci_timings"
     ],
-    "allow_failure": false,
+    "allow_failure": true,
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb12-validate+llvm.tar.xz",
+        "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -2139,11 +2073,13 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm",
-      "BUILD_FLAVOUR": "validate+llvm",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm",
+      "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+      "HADRIAN_ARGS": "--docs=none",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb12-validate+llvm",
+      "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm",
+      "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions",
       "XZ_OPT": "-9"
     }
   },
@@ -4466,69 +4402,6 @@
       "ac_cv_func_utimensat": "no"
     }
   },
-  "x86_64-freebsd13-validate": {
-    "after_script": [
-      ".gitlab/ci.sh save_cache",
-      ".gitlab/ci.sh save_test_output",
-      ".gitlab/ci.sh clean",
-      "cat ci_timings"
-    ],
-    "allow_failure": true,
-    "artifacts": {
-      "expire_in": "2 weeks",
-      "paths": [
-        "ghc-x86_64-freebsd13-validate.tar.xz",
-        "junit.xml",
-        "unexpected-test-output.tar.gz"
-      ],
-      "reports": {
-        "junit": "junit.xml"
-      },
-      "when": "always"
-    },
-    "cache": {
-      "key": "x86_64-freebsd13-$CACHE_REV",
-      "paths": [
-        "cabal-cache",
-        "toolchain"
-      ]
-    },
-    "dependencies": [],
-    "image": null,
-    "needs": [
-      {
-        "artifacts": false,
-        "job": "hadrian-ghc-in-ghci"
-      }
-    ],
-    "rules": [
-      {
-        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
-        "when": "on_success"
-      }
-    ],
-    "script": [
-      ".gitlab/ci.sh setup",
-      ".gitlab/ci.sh configure",
-      ".gitlab/ci.sh build_hadrian",
-      ".gitlab/ci.sh test_hadrian"
-    ],
-    "stage": "full-build",
-    "tags": [
-      "x86_64-freebsd13"
-    ],
-    "variables": {
-      "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate",
-      "BUILD_FLAVOUR": "validate",
-      "CABAL_INSTALL_VERSION": "3.10.2.0",
-      "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check",
-      "GHC_VERSION": "9.6.4",
-      "HADRIAN_ARGS": "--docs=no-sphinx",
-      "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-freebsd13-validate"
-    }
-  },
   "x86_64-linux-alpine3_12-validate+fully_static": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
@@ -5090,7 +4963,7 @@
       "TEST_ENV": "x86_64-linux-deb10-validate+debug_info"
     }
   },
-  "x86_64-linux-deb10-validate+thread_sanitizer": {
+  "x86_64-linux-deb10-zstd-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5101,7 +4974,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz",
+        "ghc-x86_64-linux-deb10-zstd-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5127,9 +5000,8 @@
     ],
     "rules": [
       {
-        "allow_failure": true,
-        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
-        "when": "manual"
+        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "when": "on_success"
       }
     ],
     "script": [
@@ -5145,16 +5017,14 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer",
-      "BUILD_FLAVOUR": "validate+thread_sanitizer",
-      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
-      "HADRIAN_ARGS": "--docs=none",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate",
+      "BUILD_FLAVOUR": "validate",
+      "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer",
-      "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions"
+      "TEST_ENV": "x86_64-linux-deb10-zstd-validate"
     }
   },
-  "x86_64-linux-deb10-zstd-validate": {
+  "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5165,7 +5035,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb10-zstd-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5175,14 +5045,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb10-$CACHE_REV",
+      "key": "x86_64-linux-deb11-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -5191,7 +5061,7 @@
     ],
     "rules": [
       {
-        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
         "when": "on_success"
       }
     ],
@@ -5208,14 +5078,16 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
       "BUILD_FLAVOUR": "validate",
-      "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check",
+      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
+      "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
+      "CROSS_TARGET": "aarch64-linux-gnu",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb10-zstd-validate"
+      "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
     }
   },
-  "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": {
+  "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5226,7 +5098,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5236,14 +5108,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb11-emsdk-closure-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11-emsdk-closure:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -5252,7 +5124,7 @@
     ],
     "rules": [
       {
-        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
         "when": "on_success"
       }
     ],
@@ -5268,17 +5140,18 @@
       "x86_64-linux"
     ],
     "variables": {
-      "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate",
+      "BIGNUM_BACKEND": "native",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "BUILD_FLAVOUR": "validate",
       "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
-      "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu",
-      "CROSS_TARGET": "aarch64-linux-gnu",
+      "CONFIGURE_WRAPPER": "emconfigure",
+      "CROSS_EMULATOR": "js-emulator",
+      "CROSS_TARGET": "javascript-unknown-ghcjs",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
+      "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate"
     }
   },
-  "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": {
+  "x86_64-linux-deb11-validate+boot_nonmoving_gc": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5289,7 +5162,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5315,7 +5188,7 @@
     ],
     "rules": [
       {
-        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*javascript.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
         "when": "on_success"
       }
     ],
@@ -5331,18 +5204,15 @@
       "x86_64-linux"
     ],
     "variables": {
-      "BIGNUM_BACKEND": "native",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
-      "BUILD_FLAVOUR": "validate",
-      "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
-      "CONFIGURE_WRAPPER": "emconfigure",
-      "CROSS_EMULATOR": "js-emulator",
-      "CROSS_TARGET": "javascript-unknown-ghcjs",
-      "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate"
+      "BIGNUM_BACKEND": "gmp",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc",
+      "BUILD_FLAVOUR": "validate+boot_nonmoving_gc",
+      "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+      "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity",
+      "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc"
     }
   },
-  "x86_64-linux-deb11-validate+boot_nonmoving_gc": {
+  "x86_64-linux-deb12-validate+llvm": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5353,7 +5223,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz",
+        "ghc-x86_64-linux-deb12-validate+llvm.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5363,14 +5233,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb12-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -5379,7 +5249,7 @@
     ],
     "rules": [
       {
-        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
         "when": "on_success"
       }
     ],
@@ -5396,25 +5266,25 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc",
-      "BUILD_FLAVOUR": "validate+boot_nonmoving_gc",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm",
+      "BUILD_FLAVOUR": "validate+llvm",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
-      "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity",
-      "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc"
+      "RUNTEST_ARGS": "",
+      "TEST_ENV": "x86_64-linux-deb12-validate+llvm"
     }
   },
-  "x86_64-linux-deb12-validate+llvm": {
+  "x86_64-linux-deb12-validate+thread_sanitizer_cmm": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
       ".gitlab/ci.sh clean",
       "cat ci_timings"
     ],
-    "allow_failure": false,
+    "allow_failure": true,
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb12-validate+llvm.tar.xz",
+        "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5440,8 +5310,9 @@
     ],
     "rules": [
       {
-        "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
-        "when": "on_success"
+        "allow_failure": true,
+        "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+        "when": "manual"
       }
     ],
     "script": [
@@ -5457,11 +5328,13 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+llvm",
-      "BUILD_FLAVOUR": "validate+llvm",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-validate+thread_sanitizer_cmm",
+      "BUILD_FLAVOUR": "validate+thread_sanitizer_cmm",
       "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+      "HADRIAN_ARGS": "--docs=none",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb12-validate+llvm"
+      "TEST_ENV": "x86_64-linux-deb12-validate+thread_sanitizer_cmm",
+      "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions"
     }
   },
   "x86_64-linux-fedora33-release": {

.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py

@@ -216,7 +216,8 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
                            , ">= 11": deb11
                            , "unknown_versioning": deb11 }
           , "Linux_Ubuntu" : { "unknown_versioning": ubuntu2004
-                             , "( >= 16 && < 19 )": ubuntu1804
+                             , "( >= 16 && < 18 )": deb9
+                             , "( >= 18 && < 19 )": ubuntu1804
                              }
           , "Linux_Mint"   : { "< 20": ubuntu1804
                              , ">= 20": ubuntu2004 }

.gitlab/rel_eng/recompress-all

@@ -21,7 +21,7 @@ usage :
 
 %.zip : %.tar.xz
 	echo "[tarxz->zip] $< to $@..."
-	tmp="$$(mktemp tmp.XXX)" && \
+	tmp="$$(mktemp -d tmp.XXX)" && \
 		tar -C "$$tmp" -xf $< && \
 		cd "$$tmp" && \
 		zip -9 -r $@ * && \

compiler/GHC.hs

@@ -394,6 +394,7 @@ import GHC.Types.Name.Ppr
 import GHC.Types.TypeEnv
 import GHC.Types.BreakInfo
 import GHC.Types.PkgQual
+import GHC.Types.Unique.FM
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -673,6 +674,7 @@ setTopSessionDynFlags :: GhcMonad m => DynFlags -> m ()
 setTopSessionDynFlags dflags = do
   hsc_env <- getSession
   logger  <- getLogger
+  lookup_cache  <- liftIO $ newMVar emptyUFM
 
   -- Interpreter
   interp <- if
@@ -702,7 +704,7 @@ setTopSessionDynFlags dflags = do
             }
          s <- liftIO $ newMVar InterpPending
          loader <- liftIO Loader.uninitializedLoader
-         return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader))
+         return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))
 
     -- JavaScript interpreter
     | ArchJavaScript <- platformArch (targetPlatform dflags)
@@ -720,7 +722,7 @@ setTopSessionDynFlags dflags = do
               , jsInterpFinderOpts  = initFinderOpts dflags
               , jsInterpFinderCache = hsc_FC hsc_env
               }
-         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader))
+         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))
 
     -- Internal interpreter
     | otherwise
@@ -728,7 +730,7 @@ setTopSessionDynFlags dflags = do
 #if defined(HAVE_INTERNAL_INTERPRETER)
      do
       loader <- liftIO Loader.uninitializedLoader
-      return (Just (Interp InternalInterp loader))
+      return (Just (Interp InternalInterp loader lookup_cache))
 #else
       return Nothing
 #endif

compiler/GHC/Builtin/Names.hs

@@ -273,6 +273,9 @@ basicKnownKeyNames
         -- DataToTag
         dataToTagClassName,
 
+        -- seq#
+        seqHashName,
+
         -- Dynamic
         toDynName,
 
@@ -1419,6 +1422,10 @@ nonEmptyTyConName = tcQual gHC_INTERNAL_BASE (fsLit "NonEmpty") nonEmptyTyConKey
 dataToTagClassName :: Name
 dataToTagClassName    = clsQual gHC_MAGIC      (fsLit "DataToTag") dataToTagClassKey
 
+-- seq#
+seqHashName :: Name
+seqHashName = varQual gHC_INTERNAL_IO (fsLit "seq#") seqHashKey
+
 -- Custom type errors
 errorMessageTypeErrorFamName
   , typeErrorTextDataConName
@@ -2373,7 +2380,7 @@ rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 101
 runMainKey                    = mkPreludeMiscIdUnique 102
 
-thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique
+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey, seqHashKey :: Unique
 thenIOIdKey                   = mkPreludeMiscIdUnique 103
 lazyIdKey                     = mkPreludeMiscIdUnique 104
 assertErrorIdKey              = mkPreludeMiscIdUnique 105
@@ -2408,6 +2415,8 @@ rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
 rationalToFloatIdKey   = mkPreludeMiscIdUnique 132
 rationalToDoubleIdKey  = mkPreludeMiscIdUnique 133
 
+seqHashKey             = mkPreludeMiscIdUnique 134
+
 coerceKey :: Unique
 coerceKey                     = mkPreludeMiscIdUnique 157
 

compiler/GHC/Builtin/Names/TH.hs

@@ -47,18 +47,16 @@ templateHaskellNames = [
     litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName,
     conPName, tildePName, bangPName, infixPName,
     asPName, wildPName, recPName, listPName, sigPName, viewPName,
-    typePName,
-    -- ArgPat
-    visAPName, invisAPName,
+    typePName, invisPName,
     -- FieldPat
     fieldPatName,
     -- Match
     matchName,
     -- Clause
-    clauseArgName,
+    clauseName,
     -- Exp
     varEName, conEName, litEName, appEName, appTypeEName, infixEName,
-    infixAppName, sectionLName, sectionRName, lamArgEName, lamCaseEName,
+    infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
     lamCasesEName, tupEName, unboxedTupEName, unboxedSumEName,
     condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName,
     fromEName, fromThenEName, fromToEName, fromThenToEName,
@@ -164,7 +162,7 @@ templateHaskellNames = [
     liftClassName, quoteClassName,
 
     -- And the tycons
-    qTyConName, nameTyConName, patTyConName, argPatTyConName,
+    qTyConName, nameTyConName, patTyConName,
     fieldPatTyConName, matchTyConName,
     expQTyConName, fieldExpTyConName, predTyConName,
     stmtTyConName,  decsTyConName, conTyConName, bangTypeTyConName,
@@ -210,7 +208,7 @@ liftClassName = thCls (fsLit "Lift") liftClassKey
 quoteClassName :: Name
 quoteClassName = thCls (fsLit "Quote") quoteClassKey
 
-qTyConName, nameTyConName, fieldExpTyConName, patTyConName, argPatTyConName,
+qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
     matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
     codeTyConName, injAnnTyConName, overlapTyConName, decsTyConName,
@@ -219,7 +217,6 @@ qTyConName             = thTc (fsLit "Q")              qTyConKey
 nameTyConName          = thTc (fsLit "Name")           nameTyConKey
 fieldExpTyConName      = thTc (fsLit "FieldExp")       fieldExpTyConKey
 patTyConName           = thTc (fsLit "Pat")            patTyConKey
-argPatTyConName        = thTc (fsLit "ArgPat")         argPatTyConKey
 fieldPatTyConName      = thTc (fsLit "FieldPat")       fieldPatTyConKey
 expTyConName           = thTc (fsLit "Exp")            expTyConKey
 decTyConName           = thTc (fsLit "Dec")            decTyConKey
@@ -278,7 +275,7 @@ charPrimLName   = libFun (fsLit "charPrimL")   charPrimLIdKey
 -- data Pat = ...
 litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName,
     infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName,
-    sigPName, viewPName, typePName :: Name
+    sigPName, viewPName, typePName, invisPName :: Name
 litPName   = libFun (fsLit "litP")   litPIdKey
 varPName   = libFun (fsLit "varP")   varPIdKey
 tupPName   = libFun (fsLit "tupP")   tupPIdKey
@@ -295,12 +292,7 @@ listPName  = libFun (fsLit "listP")  listPIdKey
 sigPName   = libFun (fsLit "sigP")   sigPIdKey
 viewPName  = libFun (fsLit "viewP")  viewPIdKey
 typePName  = libFun (fsLit "typeP")  typePIdKey
-
--- data ArgPat = ...
-visAPName, invisAPName :: Name
-
-visAPName   = libFun (fsLit "visAP")  visAPIdKey
-invisAPName = libFun (fsLit "invisAP")  invisAPIdKey
+invisPName = libFun (fsLit "invisP")  invisPIdKey
 
 -- type FieldPat = ...
 fieldPatName :: Name
@@ -311,12 +303,12 @@ matchName :: Name
 matchName = libFun (fsLit "match") matchIdKey
 
 -- data Clause = ...
-clauseArgName :: Name
-clauseArgName = libFun (fsLit "clauseArg") clauseArgIdKey
+clauseName :: Name
+clauseName = libFun (fsLit "clause") clauseIdKey
 
 -- data Exp = ...
 varEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName,
-    sectionLName, sectionRName, lamArgEName, lamCaseEName, lamCasesEName, tupEName,
+    sectionLName, sectionRName, lamEName, lamCaseEName, lamCasesEName, tupEName,
     unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,
     caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName,
     labelEName, implicitParamVarEName, getFieldEName, projectionEName, typeEName :: Name
@@ -329,7 +321,7 @@ infixEName            = libFun (fsLit "infixE")            infixEIdKey
 infixAppName          = libFun (fsLit "infixApp")          infixAppIdKey
 sectionLName          = libFun (fsLit "sectionL")          sectionLIdKey
 sectionRName          = libFun (fsLit "sectionR")          sectionRIdKey
-lamArgEName           = libFun (fsLit "lamArgE")           lamArgEIdKey
+lamEName              = libFun (fsLit "lamE")              lamEIdKey
 lamCaseEName          = libFun (fsLit "lamCaseE")          lamCaseEIdKey
 lamCasesEName         = libFun (fsLit "lamCasesE")         lamCasesEIdKey
 tupEName              = libFun (fsLit "tupE")              tupEIdKey
@@ -704,7 +696,7 @@ quoteClassKey = mkPreludeClassUnique 201
 -- Check in GHC.Builtin.Names if you want to change this
 
 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
-    patTyConKey, argPatTyConKey,
+    patTyConKey,
     stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey,
     tyVarBndrUnitTyConKey, tyVarBndrSpecTyConKey, tyVarBndrVisTyConKey,
     decTyConKey, bangTypeTyConKey, varBangTypeTyConKey,
@@ -720,7 +712,6 @@ clauseTyConKey          = mkPreludeTyConUnique 202
 qTyConKey               = mkPreludeTyConUnique 203
 expQTyConKey            = mkPreludeTyConUnique 204
 patTyConKey             = mkPreludeTyConUnique 206
-argPatTyConKey          = mkPreludeTyConUnique 207
 stmtTyConKey            = mkPreludeTyConUnique 209
 conTyConKey             = mkPreludeTyConUnique 210
 typeQTyConKey           = mkPreludeTyConUnique 211
@@ -848,7 +839,7 @@ liftStringIdKey     = mkPreludeMiscIdUnique 230
 -- data Pat = ...
 litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey,
   infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey,
-  listPIdKey, sigPIdKey, viewPIdKey, typePIdKey :: Unique
+  listPIdKey, sigPIdKey, viewPIdKey, typePIdKey, invisPIdKey :: Unique
 litPIdKey         = mkPreludeMiscIdUnique 240
 varPIdKey         = mkPreludeMiscIdUnique 241
 tupPIdKey         = mkPreludeMiscIdUnique 242
@@ -865,12 +856,7 @@ listPIdKey        = mkPreludeMiscIdUnique 252
 sigPIdKey         = mkPreludeMiscIdUnique 253
 viewPIdKey        = mkPreludeMiscIdUnique 254
 typePIdKey        = mkPreludeMiscIdUnique 255
-
--- data ArgPat = ...
-
-visAPIdKey, invisAPIdKey :: Unique
-visAPIdKey        = mkPreludeMiscIdUnique 256
-invisAPIdKey      = mkPreludeMiscIdUnique 257
+invisPIdKey       = mkPreludeMiscIdUnique 256
 
 -- type FieldPat = ...
 fieldPatIdKey :: Unique
@@ -881,13 +867,13 @@ matchIdKey :: Unique
 matchIdKey          = mkPreludeMiscIdUnique 261
 
 -- data Clause = ...
-clauseArgIdKey :: Unique
-clauseArgIdKey         = mkPreludeMiscIdUnique 262
+clauseIdKey :: Unique
+clauseIdKey         = mkPreludeMiscIdUnique 262
 
 
 -- data Exp = ...
 varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey,
-    infixAppIdKey, sectionLIdKey, sectionRIdKey, lamArgEIdKey, lamCaseEIdKey,
+    infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey,
     lamCasesEIdKey, tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey,
     multiIfEIdKey, letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
     fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
@@ -903,7 +889,7 @@ infixEIdKey            = mkPreludeMiscIdUnique 275
 infixAppIdKey          = mkPreludeMiscIdUnique 276
 sectionLIdKey          = mkPreludeMiscIdUnique 277
 sectionRIdKey          = mkPreludeMiscIdUnique 278
-lamArgEIdKey           = mkPreludeMiscIdUnique 279
+lamEIdKey           = mkPreludeMiscIdUnique 279
 lamCaseEIdKey          = mkPreludeMiscIdUnique 280
 lamCasesEIdKey         = mkPreludeMiscIdUnique 281
 tupEIdKey              = mkPreludeMiscIdUnique 282

compiler/GHC/Builtin/PrimOps.hs

@@ -920,11 +920,10 @@ instance Outputable PrimCall where
         = text "__primcall" <+> ppr pkgId <+> ppr lbl
 
 -- | Indicate if a primop is really inline: that is, it isn't out-of-line and it
--- isn't SeqOp/DataToTagOp which are two primops that evaluate their argument
+-- isn't DataToTagOp which are two primops that evaluate their argument
 -- hence induce thread/stack/heap changes.
 primOpIsReallyInline :: PrimOp -> Bool
 primOpIsReallyInline = \case
-  SeqOp       -> False
   DataToTagSmallOp -> False
   DataToTagLargeOp -> False
-  p           -> not (primOpOutOfLine p)
+  p                -> not (primOpOutOfLine p)

compiler/GHC/Builtin/primops.txt.pp

@@ -3656,13 +3656,6 @@ primop SparkOp "spark#" GenPrimOp
    with effect = ReadWriteEffect
    code_size = { primOpCodeSizeForeignCall }
 
--- See Note [seq# magic] in GHC.Core.Opt.ConstantFold
-primop SeqOp "seq#" GenPrimOp
-   a -> State# s -> (# State# s, a #)
-   with
-   effect = ThrowsException
-   work_free = True -- seq# does work iff its lifted arg does work
-
 primop GetSparkOp "getSpark#" GenPrimOp
    State# s -> (# State# s, Int#, a #)
    with

compiler/GHC/ByteCode/Asm.hs

@@ -34,6 +34,7 @@ import GHC.Utils.Panic
 
 import GHC.Core.TyCon
 import GHC.Data.FastString
+import GHC.Data.FlatBag
 import GHC.Data.SizedSeq
 
 import GHC.StgToCmm.Layout     ( ArgRep(..) )
@@ -71,9 +72,9 @@ bcoFreeNames bco
   where
     bco_refs (UnlinkedBCO _ _ _ _ nonptrs ptrs)
         = unionManyUniqDSets (
-             mkUniqDSet [ n | BCOPtrName n <- ssElts ptrs ] :
-             mkUniqDSet [ n | BCONPtrItbl n <- ssElts nonptrs ] :
-             map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
+             mkUniqDSet [ n | BCOPtrName n <- elemsFlatBag ptrs ] :
+             mkUniqDSet [ n | BCONPtrItbl n <- elemsFlatBag nonptrs ] :
+             map bco_refs [ bco | BCOPtrBCO bco <- elemsFlatBag ptrs ]
           )
 
 -- -----------------------------------------------------------------------------
@@ -90,7 +91,7 @@ bcoFreeNames bco
 assembleBCOs
   :: Interp
   -> Profile
-  -> [ProtoBCO Name]
+  -> FlatBag (ProtoBCO Name)
   -> [TyCon]
   -> AddrEnv
   -> Maybe ModBreaks
@@ -129,7 +130,7 @@ assembleBCOs interp profile proto_bcos tycons top_strs modbreaks = do
 -- top-level string literal bindings] in GHC.StgToByteCode for some discussion
 -- about why.
 --
-mallocStrings :: Interp -> [UnlinkedBCO] -> IO [UnlinkedBCO]
+mallocStrings ::  Interp -> FlatBag UnlinkedBCO -> IO (FlatBag UnlinkedBCO)
 mallocStrings interp ulbcos = do
   let bytestrings = reverse (execState (mapM_ collect ulbcos) [])
   ptrs <- interpCmd interp (MallocStrings bytestrings)
@@ -170,7 +171,7 @@ assembleOneBCO interp profile pbco = do
   -- TODO: the profile should be bundled with the interpreter: the rts ways are
   -- fixed for an interpreter
   ubco <- assembleBCO (profilePlatform profile) pbco
-  [ubco'] <- mallocStrings interp [ubco]
+  UnitFlatBag ubco' <- mallocStrings interp (UnitFlatBag ubco)
   return ubco'
 
 assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
@@ -213,9 +214,9 @@ assembleBCO platform (ProtoBCO { protoBCOName       = nm
              (text "bytecode instruction count mismatch")
 
   let asm_insns = ssElts final_insns
-      insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns
-      bitmap_arr = mkBitmapArray bsize bitmap
-      ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr final_lits final_ptrs
+      !insns_arr =  mkBCOByteArray $ Array.listArray (0 :: Int, fromIntegral n_insns - 1) asm_insns
+      !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap
+      ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSizedSeq final_lits) (fromSizedSeq final_ptrs)
 
   -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
   -- objects, since they might get run too early.  Disable this until
@@ -224,7 +225,7 @@ assembleBCO platform (ProtoBCO { protoBCOName       = nm
 
   return ul_bco
 
-mkBitmapArray :: Word -> [StgWord] -> UArray Int Word64
+mkBitmapArray :: Word -> [StgWord] -> UArray Int Word
 -- Here the return type must be an array of Words, not StgWords,
 -- because the underlying ByteArray# will end up as a component
 -- of a BCO object.

compiler/GHC/ByteCode/Linker.hs

@@ -24,6 +24,7 @@ import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
 
 import GHC.Builtin.PrimOps
+import GHC.Builtin.PrimOps.Ids
 import GHC.Builtin.Names
 
 import GHC.Unit.Types
@@ -38,6 +39,8 @@ import GHC.Utils.Outputable
 
 import GHC.Types.Name
 import GHC.Types.Name.Env
+import qualified GHC.Types.Id as Id
+import GHC.Types.Unique.DFM
 
 import Language.Haskell.Syntax.Module.Name
 
@@ -52,31 +55,35 @@ import GHC.Exts
 
 linkBCO
   :: Interp
+  -> PkgsLoaded
   -> LinkerEnv
   -> NameEnv Int
   -> UnlinkedBCO
   -> IO ResolvedBCO
-linkBCO interp le bco_ix
+linkBCO interp pkgs_loaded le bco_ix
            (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
   -- fromIntegral Word -> Word64 should be a no op if Word is Word64
   -- otherwise it will result in a cast to longlong on 32bit systems.
-  lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (ssElts lits0)
-  ptrs <- mapM (resolvePtr interp le bco_ix) (ssElts ptrs0)
-  return (ResolvedBCO isLittleEndian arity insns bitmap
-              (listArray (0, fromIntegral (sizeSS lits0)-1) lits)
+  (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0)
+  ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0)
+  let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits
+  return (ResolvedBCO isLittleEndian arity
+              insns
+              bitmap
+              (mkBCOByteArray lits')
               (addListToSS emptySS ptrs))
 
-lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word
-lookupLiteral interp le ptr = case ptr of
+lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word
+lookupLiteral interp pkgs_loaded le ptr = case ptr of
   BCONPtrWord lit -> return lit
   BCONPtrLbl  sym -> do
     Ptr a# <- lookupStaticPtr interp sym
     return (W# (int2Word# (addr2Int# a#)))
   BCONPtrItbl nm -> do
-    Ptr a# <- lookupIE interp (itbl_env le) nm
+    Ptr a# <- lookupIE interp pkgs_loaded (itbl_env le) nm
     return (W# (int2Word# (addr2Int# a#)))
   BCONPtrAddr nm -> do
-    Ptr a# <- lookupAddr interp (addr_env le) nm
+    Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm
     return (W# (int2Word# (addr2Int# a#)))
   BCONPtrStr _ ->
     -- should be eliminated during assembleBCOs
@@ -90,19 +97,19 @@ lookupStaticPtr interp addr_of_label_string = do
     Nothing  -> linkFail "GHC.ByteCode.Linker: can't find label"
                   (unpackFS addr_of_label_string)
 
-lookupIE :: Interp -> ItblEnv -> Name -> IO (Ptr ())
-lookupIE interp ie con_nm =
+lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ())
+lookupIE interp pkgs_loaded ie con_nm =
   case lookupNameEnv ie con_nm of
     Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a))
     Nothing -> do -- try looking up in the object files.
        let sym_to_find1 = nameToCLabel con_nm "con_info"
-       m <- lookupSymbol interp sym_to_find1
+       m <- lookupHsSymbol interp pkgs_loaded con_nm "con_info"
        case m of
           Just addr -> return addr
           Nothing
              -> do -- perhaps a nullary constructor?
                    let sym_to_find2 = nameToCLabel con_nm "static_info"
-                   n <- lookupSymbol interp sym_to_find2
+                   n <- lookupHsSymbol interp pkgs_loaded con_nm "static_info"
                    case n of
                       Just addr -> return addr
                       Nothing   -> linkFail "GHC.ByteCode.Linker.lookupIE"
@@ -110,34 +117,35 @@ lookupIE interp ie con_nm =
                                        unpackFS sym_to_find2)
 
 -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode
-lookupAddr :: Interp -> AddrEnv -> Name -> IO (Ptr ())
-lookupAddr interp ae addr_nm = do
+lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ())
+lookupAddr interp pkgs_loaded ae addr_nm = do
   case lookupNameEnv ae addr_nm of
     Just (_, AddrPtr ptr) -> return (fromRemotePtr ptr)
     Nothing -> do -- try looking up in the object files.
       let sym_to_find = nameToCLabel addr_nm "bytes"
                           -- see Note [Bytes label] in GHC.Cmm.CLabel
-      m <- lookupSymbol interp sym_to_find
+      m <- lookupHsSymbol interp pkgs_loaded addr_nm "bytes"
       case m of
         Just ptr -> return ptr
         Nothing -> linkFail "GHC.ByteCode.Linker.lookupAddr"
                      (unpackFS sym_to_find)
 
-lookupPrimOp :: Interp -> PrimOp -> IO (RemotePtr ())
-lookupPrimOp interp primop = do
+lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ())
+lookupPrimOp interp pkgs_loaded primop = do
   let sym_to_find = primopToCLabel primop "closure"
-  m <- lookupSymbol interp (mkFastString sym_to_find)
+  m <- lookupHsSymbol interp pkgs_loaded (Id.idName $ primOpId primop) "closure"
   case m of
     Just p -> return (toRemotePtr p)
     Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find
 
 resolvePtr
   :: Interp
+  -> PkgsLoaded
   -> LinkerEnv
   -> NameEnv Int
   -> BCOPtr
   -> IO ResolvedBCOPtr
-resolvePtr interp le bco_ix ptr = case ptr of
+resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of
   BCOPtrName nm
     | Just ix <- lookupNameEnv bco_ix nm
     -> return (ResolvedBCORef ix) -- ref to another BCO in this group
@@ -149,20 +157,42 @@ resolvePtr interp le bco_ix ptr = case ptr of
     -> assertPpr (isExternalName nm) (ppr nm) $
        do
           let sym_to_find = nameToCLabel nm "closure"
-          m <- lookupSymbol interp sym_to_find
+          m <- lookupHsSymbol interp pkgs_loaded nm "closure"
           case m of
             Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p))
             Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find)
 
   BCOPtrPrimOp op
-    -> ResolvedBCOStaticPtr <$> lookupPrimOp interp op
+    -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op
 
   BCOPtrBCO bco
-    -> ResolvedBCOPtrBCO <$> linkBCO interp le bco_ix bco
+    -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco
 
   BCOPtrBreakArray breakarray
     -> withForeignRef breakarray $ \ba -> return (ResolvedBCOPtrBreakArray ba)
 
+-- | Look up the address of a Haskell symbol in the currently
+-- loaded units.
+--
+-- See Note [Looking up symbols in the relevant objects].
+lookupHsSymbol :: Interp -> PkgsLoaded -> Name -> String -> IO (Maybe (Ptr ()))
+lookupHsSymbol interp pkgs_loaded nm sym_suffix = do
+  massertPpr (isExternalName nm) (ppr nm)
+  let sym_to_find = nameToCLabel nm sym_suffix
+      pkg_id = moduleUnitId $ nameModule nm
+      loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id
+
+      go (dll:dlls) = do
+        mb_ptr <- lookupSymbolInDLL interp dll sym_to_find
+        case mb_ptr of
+          Just ptr -> pure (Just ptr)
+          Nothing -> go dlls
+      go [] =
+        -- See Note [Symbols may not be found in pkgs_loaded] in GHC.Linker.Types
+        lookupSymbol interp sym_to_find
+
+  go loaded_dlls
+
 linkFail :: String -> String -> IO a
 linkFail who what
    = throwGhcExceptionIO (ProgramError $

compiler/GHC/ByteCode/Types.hs

 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE MagicHash                  #-}
+{-# LANGUAGE UnliftedNewtypes           #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -8,6 +10,7 @@
 -- | Bytecode assembler types
 module GHC.ByteCode.Types
   ( CompiledByteCode(..), seqCompiledByteCode
+  , BCOByteArray(..), mkBCOByteArray
   , FFIInfo(..)
   , RegBitmap(..)
   , NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo
@@ -18,12 +21,13 @@ module GHC.ByteCode.Types
   , CgBreakInfo(..)
   , ModBreaks (..), BreakIndex, emptyModBreaks
   , CCostCentre
+  , FlatBag, sizeFlatBag, fromSizedSeq, elemsFlatBag
   ) where
 
 import GHC.Prelude
 
 import GHC.Data.FastString
-import GHC.Data.SizedSeq
+import GHC.Data.FlatBag
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Utils.Outputable
@@ -33,10 +37,10 @@ import GHCi.BreakArray
 import GHCi.RemoteTypes
 import GHCi.FFI
 import Control.DeepSeq
+import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
 
 import Foreign
 import Data.Array
-import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
@@ -50,7 +54,7 @@ import Language.Haskell.Syntax.Module.Name (ModuleName)
 -- Compiled Byte Code
 
 data CompiledByteCode = CompiledByteCode
-  { bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings
+  { bc_bcos   :: FlatBag UnlinkedBCO -- Bunch of interpretable bindings
   , bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls
   , bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated
   , bc_strs   :: AddrEnv        -- malloc'd top-level strings
@@ -62,7 +66,7 @@ newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
   deriving (Show, NFData)
 
 instance Outputable CompiledByteCode where
-  ppr CompiledByteCode{..} = ppr bc_bcos
+  ppr CompiledByteCode{..} = ppr $ elemsFlatBag bc_bcos
 
 -- Not a real NFData instance, because ModBreaks contains some things
 -- we can't rnf
@@ -152,10 +156,10 @@ data UnlinkedBCO
    = UnlinkedBCO {
         unlinkedBCOName   :: !Name,
         unlinkedBCOArity  :: {-# UNPACK #-} !Int,
-        unlinkedBCOInstrs :: !(UArray Int Word16),      -- insns
-        unlinkedBCOBitmap :: !(UArray Int Word64),      -- bitmap
-        unlinkedBCOLits   :: !(SizedSeq BCONPtr),       -- non-ptrs
-        unlinkedBCOPtrs   :: !(SizedSeq BCOPtr)         -- ptrs
+        unlinkedBCOInstrs :: !(BCOByteArray Word16),      -- insns
+        unlinkedBCOBitmap :: !(BCOByteArray Word),      -- bitmap
+        unlinkedBCOLits   :: !(FlatBag BCONPtr),       -- non-ptrs
+        unlinkedBCOPtrs   :: !(FlatBag BCOPtr)         -- ptrs
    }
 
 instance NFData UnlinkedBCO where
@@ -210,8 +214,8 @@ seqCgBreakInfo CgBreakInfo{..} =
 instance Outputable UnlinkedBCO where
    ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
       = sep [text "BCO", ppr nm, text "with",
-             ppr (sizeSS lits), text "lits",
-             ppr (sizeSS ptrs), text "ptrs" ]
+             ppr (sizeFlatBag lits), text "lits",
+             ppr (sizeFlatBag ptrs), text "ptrs" ]
 
 instance Outputable CgBreakInfo where
    ppr info = text "CgBreakInfo" <+>

compiler/GHC/Cmm/ThreadSanitizer.hs

@@ -184,7 +184,7 @@ saveRestoreCallerRegs us platform =
     restore = blockFromList restore_nodes
 
 -- | Mirrors __tsan_memory_order
--- <https://github.com/llvm-mirror/compiler-rt/blob/master/include/sanitizer/tsan_interface_atomic.h#L32>
+-- <https://github.com/llvm/llvm-project/blob/main/compiler-rt/include/sanitizer/tsan_interface_atomic.h#L34>
 memoryOrderToTsanMemoryOrder :: Env -> MemoryOrdering -> CmmExpr
 memoryOrderToTsanMemoryOrder env mord =
     mkIntExpr (platform env) n
@@ -294,4 +294,3 @@ tsanAtomicRMW env mord op w addr val dest =
            AMO_Or   -> "fetch_or"
            AMO_Xor  -> "fetch_xor"
     fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_" ++ op'
-

compiler/GHC/CmmToAsm/AArch64.hs

@@ -47,6 +47,7 @@ instance Instruction AArch64.Instr where
         patchRegsOfInstr        = AArch64.patchRegsOfInstr
         isJumpishInstr          = AArch64.isJumpishInstr
         jumpDestsOfInstr        = AArch64.jumpDestsOfInstr
+        canFallthroughTo        = AArch64.canFallthroughTo
         patchJumpInstr          = AArch64.patchJumpInstr
         mkSpillInstr            = AArch64.mkSpillInstr
         mkLoadInstr             = AArch64.mkLoadInstr

compiler/GHC/CmmToAsm/AArch64/CodeGen.hs

@@ -1556,7 +1556,7 @@ genCCall target dest_regs arg_regs bid = do
   -- pprTraceM "genCCall target" (ppr target)
   -- pprTraceM "genCCall formal" (ppr dest_regs)
   -- pprTraceM "genCCall actual" (ppr arg_regs)
-
+  platform <- getPlatform
   case target of
     -- The target :: ForeignTarget call can either
     -- be a foreign procedure with an address expr
@@ -1584,7 +1584,6 @@ genCCall target dest_regs arg_regs bid = do
       let (_res_hints, arg_hints) = foreignTargetHints target
           arg_regs'' = zipWith (\(r, f, c) h -> (r,f,h,c)) arg_regs' arg_hints
 
-      platform <- getPlatform
       let packStack = platformOS platform == OSDarwin
 
       (stackSpace', passRegs, passArgumentsCode) <- passArguments packStack allGpArgRegs allFpArgRegs arg_regs'' 0 [] nilOL
@@ -1625,6 +1624,139 @@ genCCall target dest_regs arg_regs bid = do
       | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs ->
         unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg
 
+    PrimTarget (MO_S_Mul2 w)
+          -- Life is easier when we're working with word sized operands,
+          -- we can use SMULH to compute the high 64 bits, and dst_needed
+          -- checks if the high half's bits are all the same as the low half's
+          -- top bit.
+          | w == W64
+          , [src_a, src_b] <- arg_regs
+          -- dst_needed = did the result fit into just the low half
+          , [dst_needed, dst_hi, dst_lo] <- dest_regs
+            ->  do
+              (reg_a, _format_x, code_x) <- getSomeReg src_a
+              (reg_b, _format_y, code_y) <- getSomeReg src_b
+
+              let lo = getRegisterReg platform (CmmLocal dst_lo)
+                  hi = getRegisterReg platform (CmmLocal dst_hi)
+                  nd = getRegisterReg platform (CmmLocal dst_needed)
+              return (
+                  code_x `appOL`
+                  code_y `snocOL`
+                  MUL   (OpReg W64 lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
+                  SMULH (OpReg W64 hi) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
+                  -- Are all high bits equal to the sign bit of the low word?
+                  -- nd = (hi == ASR(lo,width-1)) ? 1 : 0
+                  CMP   (OpReg W64 hi) (OpRegShift W64 lo SASR (widthInBits w - 1)) `snocOL`
+                  CSET  (OpReg W64 nd) NE
+                  , Nothing)
+            -- For sizes < platform width, we can just perform a multiply and shift
+            -- using the normal 64 bit multiply. Calculating the dst_needed value is
+            -- complicated a little by the need to be careful when truncation happens.
+            -- Currently this case can't be generated since
+            -- timesInt2# :: Int# -> Int# -> (# Int#, Int#, Int# #)
+            -- TODO: Should this be removed or would other primops be useful?
+          | w < W64
+          , [src_a, src_b] <- arg_regs
+          , [dst_needed, dst_hi, dst_lo] <- dest_regs
+            ->  do
+              (reg_a', _format_x, code_a) <- getSomeReg src_a
+              (reg_b', _format_y, code_b) <- getSomeReg src_b
+
+              let lo = getRegisterReg platform (CmmLocal dst_lo)
+                  hi = getRegisterReg platform (CmmLocal dst_hi)
+                  nd = getRegisterReg platform (CmmLocal dst_needed)
+                  -- Do everything in a full 64 bit registers
+                  w' = platformWordWidth platform
+
+              (reg_a, code_a') <- signExtendReg w w' reg_a'
+              (reg_b, code_b') <- signExtendReg w w' reg_b'
+
+              return (
+                  code_a  `appOL`
+                  code_b  `appOL`
+                  code_a' `appOL`
+                  code_b' `snocOL`
+                  -- the low 2w' of lo contains the full multiplication;
+                  -- eg: int8 * int8 -> int16 result
+                  -- so lo is in the last w of the register, and hi is in the second w.
+                  SMULL (OpReg w' lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
+                  -- Make sure we hold onto the sign bits for dst_needed
+                  ASR (OpReg w' hi) (OpReg w' lo)    (OpImm (ImmInt $ widthInBits w)) `appOL`
+                  -- lo can now be truncated so we can get at it's top bit easily.
+                  truncateReg w' w lo `snocOL`
+                  -- Note the use of CMN (compare negative), not CMP: we want to
+                  -- test if the top half is negative one and the top
+                  -- bit of the bottom half is positive one. eg:
+                  -- hi = 0b1111_1111  (actually 64 bits)
+                  -- lo = 0b1010_1111  (-81, so the result didn't need the top half)
+                  -- lo' = ASR(lo,7)   (second reg of SMN)
+                  --     = 0b0000_0001 (theeshift gives us 1 for negative,
+                  --                    and 0 for positive)
+                  -- hi == -lo'?
+                  -- 0b1111_1111 == 0b1111_1111 (yes, top half is just overflow)
+                  -- Another way to think of this is if hi + lo' == 0, which is what
+                  -- CMN really is under the hood.
+                  CMN   (OpReg w' hi) (OpRegShift w' lo SLSR (widthInBits w - 1)) `snocOL`
+                  -- Set dst_needed to 1 if hi and lo' were (negatively) equal
+                  CSET  (OpReg w' nd) EQ `appOL`
+                  -- Finally truncate hi to drop any extraneous sign bits.
+                  truncateReg w' w hi
+                  , Nothing)
+          -- Can't handle > 64 bit operands
+          | otherwise -> unsupported (MO_S_Mul2 w)
+    PrimTarget (MO_U_Mul2  w)
+          -- The unsigned case is much simpler than the signed, all we need to
+          -- do is the multiplication straight into the destination registers.
+          | w == W64
+          , [src_a, src_b] <- arg_regs
+          , [dst_hi, dst_lo] <- dest_regs
+            ->  do
+              (reg_a, _format_x, code_x) <- getSomeReg src_a
+              (reg_b, _format_y, code_y) <- getSomeReg src_b
+
+              let lo = getRegisterReg platform (CmmLocal dst_lo)
+                  hi = getRegisterReg platform (CmmLocal dst_hi)
+              return (
+                  code_x `appOL`
+                  code_y `snocOL`
+                  MUL   (OpReg W64 lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
+                  UMULH (OpReg W64 hi) (OpReg W64 reg_a) (OpReg W64 reg_b)
+                  , Nothing)
+            -- For sizes < platform width, we can just perform a multiply and shift
+            -- Need to be careful to truncate the low half, but the upper half should be
+            -- be ok if the invariant in [Signed arithmetic on AArch64] is maintained.
+            -- Currently this case can't be produced by the compiler since
+            -- timesWord2# :: Word# -> Word# -> (# Word#, Word# #)
+            -- TODO: Remove? Or would the extra primop be useful for avoiding the extra
+            -- steps needed to do this in userland?
+          | w < W64
+          , [src_a, src_b] <- arg_regs
+          , [dst_hi, dst_lo] <- dest_regs
+            ->  do
+              (reg_a, _format_x, code_x) <- getSomeReg src_a
+              (reg_b, _format_y, code_y) <- getSomeReg src_b
+
+              let lo = getRegisterReg platform (CmmLocal dst_lo)
+                  hi = getRegisterReg platform (CmmLocal dst_hi)
+                  w' = opRegWidth w
+              return (
+                  code_x `appOL`
+                  code_y `snocOL`
+                  -- UMULL: Xd = Wa * Wb with 64 bit result
+                  -- W64 inputs should have been caught by case above
+                  UMULL (OpReg W64 lo) (OpReg w' reg_a) (OpReg w' reg_b) `snocOL`
+                  -- Extract and truncate high result
+                  -- hi[w:0] = lo[2w:w]
+                  UBFX (OpReg W64 hi) (OpReg W64 lo)
+                      (OpImm (ImmInt $ widthInBits w)) -- lsb
+                      (OpImm (ImmInt $ widthInBits w)) -- width to extract
+                      `appOL`
+                  truncateReg W64 w lo
+                  , Nothing)
+          | otherwise -> unsupported (MO_U_Mul2  w)
+
+
     -- or a possibly side-effecting machine operation
     -- mop :: CallishMachOp (see GHC.Cmm.MachOp)
     PrimTarget mop -> do
@@ -1714,7 +1846,6 @@ genCCall target dest_regs arg_regs bid = do
 
         -- Arithmatic
         -- These are not supported on X86, so I doubt they are used much.
-        MO_S_Mul2     _w -> unsupported mop
         MO_S_QuotRem  _w -> unsupported mop
         MO_U_QuotRem  _w -> unsupported mop
         MO_U_QuotRem2 _w -> unsupported mop
@@ -1723,7 +1854,6 @@ genCCall target dest_regs arg_regs bid = do
         MO_SubWordC   _w -> unsupported mop
         MO_AddIntC    _w -> unsupported mop
         MO_SubIntC    _w -> unsupported mop
-        MO_U_Mul2     _w -> unsupported mop
 
         -- Memory Ordering
         MO_AcquireFence     ->  return (unitOL DMBISH, Nothing)

compiler/GHC/CmmToAsm/AArch64/Instr.hs

@@ -79,11 +79,14 @@ regUsageOfInstr platform instr = case instr of
   -- 1. Arithmetic Instructions ------------------------------------------------
   ADD dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   CMP l r                  -> usage (regOp l ++ regOp r, [])
+  CMN l r                  -> usage (regOp l ++ regOp r, [])
   MSUB dst src1 src2 src3  -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
   MUL dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   NEG dst src              -> usage (regOp src, regOp dst)
   SMULH dst src1 src2      -> usage (regOp src1 ++ regOp src2, regOp dst)
   SMULL dst src1 src2      -> usage (regOp src1 ++ regOp src2, regOp dst)
+  UMULH dst src1 src2      -> usage (regOp src1 ++ regOp src2, regOp dst)
+  UMULL dst src1 src2      -> usage (regOp src1 ++ regOp src2, regOp dst)
   SDIV dst src1 src2       -> usage (regOp src1 ++ regOp src2, regOp dst)
   SUB dst src1 src2        -> usage (regOp src1 ++ regOp src2, regOp dst)
   UDIV dst src1 src2       -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -209,11 +212,14 @@ patchRegsOfInstr instr env = case instr of
     -- 1. Arithmetic Instructions ----------------------------------------------
     ADD o1 o2 o3   -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
     CMP o1 o2      -> CMP (patchOp o1) (patchOp o2)
+    CMN o1 o2      -> CMN (patchOp o1) (patchOp o2)
     MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
     MUL o1 o2 o3   -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
     NEG o1 o2      -> NEG (patchOp o1) (patchOp o2)
     SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2)  (patchOp o3)
     SMULL o1 o2 o3 -> SMULL (patchOp o1) (patchOp o2)  (patchOp o3)
+    UMULH o1 o2 o3 -> UMULH (patchOp o1) (patchOp o2)  (patchOp o3)
+    UMULL o1 o2 o3 -> UMULL (patchOp o1) (patchOp o2)  (patchOp o3)
     SDIV o1 o2 o3  -> SDIV (patchOp o1) (patchOp o2) (patchOp o3)
     SUB o1 o2 o3   -> SUB  (patchOp o1) (patchOp o2) (patchOp o3)
     UDIV o1 o2 o3  -> UDIV (patchOp o1) (patchOp o2) (patchOp o3)
@@ -311,6 +317,12 @@ jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr _ = []
 
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid
+canFallthroughTo (J (TBlock target)) bid = bid == target
+canFallthroughTo (B (TBlock target)) bid = bid == target
+canFallthroughTo _ _ = False
+
 -- | Change the destination of this jump instruction.
 -- Used in the linear allocator when adding fixup blocks for join
 -- points.
@@ -540,6 +552,7 @@ data Instr
     -- | ADR ...
     -- | ADRP ...
     | CMP Operand Operand -- rd - op2
+    | CMN Operand Operand -- rd + op2
     -- | MADD ...
     -- | MNEG ...
     | MSUB Operand Operand Operand Operand -- rd = ra - rn × rm
@@ -562,8 +575,8 @@ data Instr
     -- | UMADDL ...  -- Xd = Xa + Wn × Wm
     -- | UMNEGL ... -- Xd = - Wn × Wm
     -- | UMSUBL ... -- Xd = Xa - Wn × Wm
-    -- | UMULH ... -- Xd = (Xn × Xm)_127:64
-    -- | UMULL ... -- Xd = Wn × Wm
+    | UMULH Operand Operand Operand -- Xd = (Xn × Xm)_127:64
+    | UMULL Operand Operand Operand -- Xd = Wn × Wm
 
     -- 2. Bit Manipulation Instructions ----------------------------------------
     | SBFM Operand Operand Operand Operand -- rd = rn[i,j]
@@ -644,12 +657,15 @@ instrCon i =
       POP_STACK_FRAME{} -> "POP_STACK_FRAME"
       ADD{} -> "ADD"
       CMP{} -> "CMP"
+      CMN{} -> "CMN"
       MSUB{} -> "MSUB"
       MUL{} -> "MUL"
       NEG{} -> "NEG"
       SDIV{} -> "SDIV"
       SMULH{} -> "SMULH"
       SMULL{} -> "SMULL"
+      UMULH{} -> "UMULH"
+      UMULL{} -> "UMULL"
       SUB{} -> "SUB"
       UDIV{} -> "UDIV"
       SBFM{} -> "SBFM"

compiler/GHC/CmmToAsm/AArch64/Ppr.hs

@@ -372,12 +372,15 @@ pprInstr platform instr = case instr of
   CMP  o1 o2
     | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2
     | otherwise -> op2 (text "\tcmp") o1 o2
+  CMN  o1 o2       -> op2 (text "\tcmn") o1 o2
   MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4
   MUL  o1 o2 o3
     | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3
     | otherwise -> op3 (text "\tmul") o1 o2 o3
   SMULH o1 o2 o3 -> op3 (text "\tsmulh") o1 o2 o3
   SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3
+  UMULH o1 o2 o3 -> op3 (text "\tumulh") o1 o2 o3
+  UMULL o1 o2 o3 -> op3 (text "\tumull") o1 o2 o3
   NEG  o1 o2
     | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2
     | otherwise -> op2 (text "\tneg") o1 o2

compiler/GHC/CmmToAsm/BlockLayout.hs

@@ -771,10 +771,9 @@ dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i]
 dropJumps _    [] = []
 dropJumps info (BasicBlock lbl ins:todo)
     | Just ins <- nonEmpty ins --This can happen because of shortcutting
-    , [dest] <- jumpDestsOfInstr (NE.last ins)
     , BasicBlock nextLbl _ : _ <- todo
-    , not (mapMember dest info)
-    , nextLbl == dest
+    , canFallthroughTo (NE.last ins) nextLbl
+    , not (mapMember nextLbl info)
     = BasicBlock lbl (NE.init ins) : dropJumps info todo
     | otherwise
     = BasicBlock lbl ins : dropJumps info todo