22 Sep '26
Magnus pushed to branch wip/mangoiv/ci-stages at Glasgow Haskell Compiler / GHC
Commits:
9a6e6445 by mangoiv at 2026-09-22T17:21:14+02:00
ci: restore stage1 tests
- - - - -
3 changed files:
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -658,6 +658,23 @@ function find_bindist_tar() {
fi
}
+# stage 1 tests -- these do not run as part
+# of the test stage but already as part of the
+# build stage as they don't require a bindist
+function test_hadrian_stage1() {
+ if [[ "${CI_JOB_NAME}" != *"windows"* ]] && [ -z "${CROSS_TARGET:-}" ] && [ -x "${REINSTALL_GHC:-}" ]
+
+ then
+ run_hadrian \
+ test \
+ --test-root-dirs=testsuite/tests/stage1 \
+ --test-compiler=stage1 \
+ ${TEST_WAYS[@]/#/--test-way=} \
+ "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian stage1 test"
+ info "STAGE1_TEST=$?"
+ fi
+}
+
function test_hadrian() {
find_bindist_tar
@@ -737,17 +754,6 @@ function test_hadrian() {
local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
install_bindist $dist_dir/ghc-*/ "$instdir"
- # if [[ "${CI_JOB_NAME}" != *"windows"* ]] && [ -z "${CROSS_TARGET:-}" ]
- # then
- # run_hadrian \
- # test \
- # --test-root-dirs=testsuite/tests/stage1 \
- # --test-compiler=stage1 \
- # ${TEST_WAYS[@]/#/--test-way=} \
- # "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian stage1 test"
- # info "STAGE1_TEST=$?"
- # fi
-
# Ensure the resulting compiler has the correct bignum-flavour,
# except for cross-compilers as they may not support the interpreter
if [ -z "${CROSS_TARGET:-}" ]
@@ -1154,6 +1160,10 @@ case ${1:-help} in
time_it "test" test_hadrian || res=$?
push_perf_notes
exit $res ;;
+ test_hadrian_stage1)
+ res=0
+ time_it "stage1 tests" test_hadrian_stage1 || res=$?
+ exit $res ;;
run_hadrian) shift; run_hadrian "$@" ;;
perf_test) run_perf_test ;;
abi_test) abi_test ;;
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -882,6 +882,7 @@ job arch opsys buildConfig =
= [ "bash .gitlab/ci.sh setup"
, "bash .gitlab/ci.sh configure"
, "bash .gitlab/ci.sh build_hadrian"
+ , "bash .gitlab/ci.sh test_hadrian_stage1"
]
| otherwise
= [ "find libraries -name config.sub -exec cp config.sub {} \\;" | Darwin == opsys ] ++
@@ -889,6 +890,7 @@ job arch opsys buildConfig =
[ ".gitlab/ci.sh setup"
, ".gitlab/ci.sh configure"
, ".gitlab/ci.sh build_hadrian"
+ , ".gitlab/ci.sh test_hadrian_stage1"
]
jobAfterScript
=====================================
.gitlab/jobs.yaml
=====================================
@@ -44,7 +44,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -173,7 +174,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -297,7 +299,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -419,7 +422,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -541,7 +545,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -623,7 +628,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -869,7 +875,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -930,7 +937,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1113,7 +1121,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1237,7 +1246,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1359,7 +1369,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1481,7 +1492,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1603,7 +1615,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1734,7 +1747,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1860,7 +1874,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -1984,7 +1999,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2108,7 +2124,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2191,7 +2208,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2440,7 +2458,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2502,7 +2521,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2688,7 +2708,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2814,7 +2835,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -2938,7 +2960,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3062,7 +3085,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3186,7 +3210,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3322,7 +3347,8 @@
"script": [
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3453,7 +3479,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3579,7 +3606,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3705,7 +3733,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3831,7 +3860,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -3961,7 +3991,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4091,7 +4122,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4221,7 +4253,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4351,7 +4384,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4413,7 +4447,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4599,7 +4634,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4723,7 +4759,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4853,7 +4890,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -4977,7 +5015,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5101,7 +5140,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5227,7 +5267,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5413,7 +5454,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5543,7 +5585,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5667,7 +5710,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5729,7 +5773,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5853,7 +5898,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -5977,7 +6023,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6167,7 +6214,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6291,7 +6339,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6353,7 +6402,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6541,7 +6591,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6603,7 +6654,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6665,7 +6717,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -6917,7 +6970,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7041,7 +7095,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7165,7 +7220,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7295,7 +7351,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7414,7 +7471,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7538,7 +7596,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7667,7 +7726,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7800,7 +7860,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -7928,7 +7989,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8054,7 +8116,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8180,7 +8243,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8306,7 +8370,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8434,7 +8499,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8560,7 +8626,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8686,7 +8753,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8812,7 +8880,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -8950,7 +9019,8 @@
"script": [
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9083,7 +9153,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9211,7 +9282,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9339,7 +9411,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9467,7 +9540,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9530,7 +9604,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9719,7 +9794,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9845,7 +9921,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -9971,7 +10048,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10034,7 +10112,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10160,7 +10239,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10351,7 +10431,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10477,7 +10558,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10603,7 +10685,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10724,7 +10807,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10850,7 +10934,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -10981,7 +11066,8 @@
"find libraries -name config.sub -exec cp config.sub {} \\;",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11115,7 +11201,8 @@
"script": [
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11244,7 +11331,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11368,7 +11456,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11492,7 +11581,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11616,7 +11706,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11745,7 +11836,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -11875,7 +11967,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12004,7 +12097,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12132,7 +12226,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12193,7 +12288,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12376,7 +12472,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12498,7 +12595,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12626,7 +12724,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12749,7 +12848,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12872,7 +12972,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -12996,7 +13097,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13179,7 +13281,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13307,7 +13410,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13429,7 +13533,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13490,7 +13595,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13612,7 +13718,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13735,7 +13842,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -13923,7 +14031,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14045,7 +14154,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14106,7 +14216,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14291,7 +14402,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14352,7 +14464,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14413,7 +14526,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14661,7 +14775,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14783,7 +14898,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -14905,7 +15021,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -15033,7 +15150,8 @@
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
- ".gitlab/ci.sh build_hadrian"
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -15150,7 +15268,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
@@ -15272,7 +15391,8 @@
"script": [
"bash .gitlab/ci.sh setup",
"bash .gitlab/ci.sh configure",
- "bash .gitlab/ci.sh build_hadrian"
+ "bash .gitlab/ci.sh build_hadrian",
+ "bash .gitlab/ci.sh test_hadrian_stage1"
],
"stage": "full-build",
"tags": [
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a6e6445089a56781bb8f818038ade6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a6e6445089a56781bb8f818038ade6…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/dep-json] 4 commits: Refactor Makefile to use phases appropriately
by Hannes Siebenhandl (＠fendor) 22 Sep '26
by Hannes Siebenhandl (＠fendor) 22 Sep '26
22 Sep '26
Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC
Commits:
ab840b56 by fendor at 2026-09-22T16:37:41+02:00
Refactor Makefile to use phases appropriately
Prepare refactoring to allow json and Makefile implementation
- - - - -
26306fd8 by fendor at 2026-09-22T16:47:47+02:00
Abstract dependency processing from Makefile generation
Allows multiple consumers
- - - - -
d3e2eadf by fendor at 2026-09-22T16:53:12+02:00
Add json output format
- - - - -
92d1b66e by fendor at 2026-09-22T16:53:13+02:00
Add -dep-json test with multiple deps
- - - - -
22 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Pipeline/Phases.hs
- compiler/GHC/Driver/Session.hs
- + testsuite/tests/driver/T24384/A.hs
- + testsuite/tests/driver/T24384/C.hs
- + testsuite/tests/driver/T24384/C.hs-boot
- + testsuite/tests/driver/T24384/D.hs
- + testsuite/tests/driver/T24384/E.hs
- + testsuite/tests/driver/T24384/Makefile
- + testsuite/tests/driver/T24384/T24384.stdout
- + testsuite/tests/driver/T24384/all.T
- + testsuite/tests/driver/T24384/dep-internal/DepInternal.hs
- + testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg
- + testsuite/tests/driver/T24384/dep-public/DepPublic.hs
- + testsuite/tests/driver/T24384/dep-public/dep-public.pkg
- + testsuite/tests/driver/T24384/dep/Dep.hs
- + testsuite/tests/driver/T24384/dep/dep.pkg
- + testsuite/tests/driver/T24384/lib/B.hs
- + testsuite/tests/driver/T24384/preproc.sh
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -351,6 +351,7 @@ data DynFlags = DynFlags {
-- For ghc -M
depMakefile :: FilePath,
+ depJson :: Maybe FilePath,
depIncludePkgDeps :: Bool,
depIncludeCppDeps :: Bool,
depExcludeMods :: [ModuleName],
@@ -694,6 +695,7 @@ defaultDynFlags mySettings =
-- ghc -M values
depMakefile = "Makefile",
+ depJson = Nothing,
depIncludePkgDeps = False,
depIncludeCppDeps = False,
depExcludeMods = [],
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -7,6 +7,8 @@
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE RecordWildCards #-}
module GHC.Driver.MakeFile
( doMkDependHS
@@ -16,47 +18,64 @@ where
import GHC.Prelude
-import qualified GHC
-import GHC.Driver.Make
-import GHC.Driver.Monad
+import GHC qualified
+
+import GHC.Data.Bag (listToBag)
+import GHC.Data.FastString (lexicalCompareFS, unpackFS)
+import GHC.Data.Graph.Directed (SCC (..))
+import GHC.Data.OsPath (unsafeDecodeUtf, unsafeEncodeUtf)
+
import GHC.Driver.DynFlags
-import GHC.Utils.Misc
import GHC.Driver.Env
import GHC.Driver.Errors.Types
-import GHC.Types.UnresolvedImport
-import qualified GHC.SysTools as SysTools
-import GHC.Data.Graph.Directed ( SCC(..) )
-import GHC.Data.OsPath (unsafeDecodeUtf)
-import GHC.Utils.Outputable
-import GHC.Utils.Panic
-import GHC.Types.SourceError
-import GHC.Types.SrcLoc
-import GHC.Types.PkgQual
-import Data.List (partition)
-import GHC.Utils.TmpFs
+import GHC.Driver.Make
+import GHC.Driver.Monad
+import GHC.Driver.Phases
+import GHC.Driver.Pipeline
+import GHC.Driver.Pipeline.Monad
+import GHC.Driver.Session
+import GHC.Iface.Errors.Types
import GHC.Iface.Load (cannotFindModule)
+import GHC.SysTools qualified as SysTools
+import GHC.Types.PkgQual
+import GHC.Types.SourceError
+import GHC.Types.SrcLoc
+import GHC.Types.Unique.Set (UniqSet)
+import GHC.Types.Unique.Set qualified as UniqSet
+import GHC.Types.UnresolvedImport
+
+import GHC.Unit.Finder
+import GHC.Unit.Info
import GHC.Unit.Module
-import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Graph
-import GHC.Unit.Finder
+import GHC.Unit.Module.ModSummary
+import GHC.Unit.State (lookupUnitId)
-import GHC.Utils.Exception
import GHC.Utils.Error
+import GHC.Utils.Exception
+import GHC.Utils.Json
import GHC.Utils.Logger
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+import GHC.Utils.TmpFs
+import Control.Monad (when)
+import Data.Either
+import Data.Foldable (traverse_)
+import Data.IORef
+import Data.List (partition)
+import Data.Map.Strict qualified as Map
+import Data.Maybe (isJust, isNothing)
+import Data.Semigroup qualified as Semigroup
+import Data.Set qualified as Set
+import GHC.Generics (Generic, Generically (..))
import System.Directory
import System.FilePath
import System.IO
-import System.IO.Error ( isEOFError )
-import Control.Monad ( when, forM_ )
-import Data.Maybe ( isJust )
-import Data.IORef
-import qualified Data.Set as Set
-import GHC.Iface.Errors.Types
-import Data.Either
-import GHC.Data.Bag (listToBag)
+import System.IO.Error (isEOFError)
-----------------------------------------------------------------
--
@@ -98,27 +117,52 @@ doMkDependHS srcs = do
doMkDependModuleGraph :: GhcMonad m => DynFlags -> ModuleGraph -> m ()
doMkDependModuleGraph dflags module_graph = do
+ hsc_env <- getSession
logger <- getLogger
- tmpfs <- hsc_tmpfs <$> getSession
- let excl_mods = depExcludeMods dflags
+ let
+ tmpfs = hsc_tmpfs hsc_env
+ excl_mods = depExcludeMods dflags
- files <- liftIO $ beginMkDependHS logger tmpfs dflags
- let sorted = GHC.topSortModuleGraph False module_graph Nothing
+ root <- liftIO getCurrentDirectory
+ let
+ dep_writer =
+ concat
+ [ [ SomeDependencyWriter $ initFileDepWriter logger root tmpfs dflags
+ ]
+ , [ SomeDependencyWriter $ initJsonDepWriter json_output dflags
+ | Just json_output <- [depJson dflags]
+ ]
+ ]
+
+ let sorted = GHC.topSortModuleGraph False module_graph Nothing
-- Print out the dependencies if wanted
liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted)
- -- Process them one by one, dumping results into makefile
- -- and complaining about cycles
- hsc_env <- getSession
- root <- liftIO getCurrentDirectory
- mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
-
- -- If -ddump-mod-cycles, show cycles in the module graph
- liftIO $ dumpModCycles logger module_graph
-
- -- Tidy up
- liftIO $ endMkDependHS logger files
+ liftIO $ bracket
+ (do
+ traverse
+ (\ (SomeDependencyWriter writer) -> do
+ backend <- dw_beginWriter writer
+ pure $ SomeActiveDependencyWriter (writer, backend)
+ )
+ dep_writer
+ )
+ -- Tidy up
+ (\ writers -> do
+ traverse_
+ (\ (SomeActiveDependencyWriter (writer, backend)) -> do
+ dw_endWriter writer backend
+ )
+ writers
+ )
+ ( \ writers -> do
+ -- Process them one by one, dumping results and complaining about cycles
+ mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) writers) sorted
+
+ -- If -ddump-mod-cycles, show cycles in the module graph
+ liftIO $ dumpModCycles logger module_graph
+ )
-- Unconditional exiting is a bad idea. If an error occurs we'll get an
--exception; if that is not caught it's fine, but at least we have a
@@ -127,6 +171,196 @@ doMkDependModuleGraph dflags module_graph = do
--`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)
+--------------------------------------------------------------------------------
+-- Types abstracting over the output
+--------------------------------------------------------------------------------
+
+data DepNode =
+ DepNode
+ { dn_mod :: Module
+ , dn_src :: FilePath
+ , dn_obj :: FilePath
+ , dn_hi :: FilePath
+ , dn_boot :: IsBootInterface
+ , dn_preprocessing :: PreprocessingNode
+ }
+
+data PreprocessingNode = PreprocessingNode
+ { pn_preprocessor :: Maybe String
+ , pn_options :: [String]
+ }
+
+data Dep
+ = DepHi
+ { dep_mod :: Module
+ , dep_path :: FilePath
+ , dep_unit :: Maybe UnitInfo
+ , dep_local :: Bool
+ , dep_boot :: IsBootInterface
+ }
+ | DepCpp
+ { dep_path :: FilePath
+ }
+
+data SomeDependencyWriter = forall backend . SomeDependencyWriter (DependencyWriter backend)
+
+data SomeActiveDependencyWriter = forall backend . SomeActiveDependencyWriter (DependencyWriter backend, backend)
+
+data DependencyWriter backend = DependencyWriter
+ { dw_beginWriter :: IO backend
+ , dw_writeDependency :: backend -> DepNode -> [Dep] -> IO ()
+ , dw_endWriter :: backend -> IO ()
+ }
+
+-----------------------------------------------------------------
+--
+-- processDeps
+--
+-----------------------------------------------------------------
+
+processDeps :: DynFlags
+ -> HscEnv
+ -> UniqSet ModuleName -- ^ Excludes
+ -> [SomeActiveDependencyWriter]
+ -> SCC ModuleGraphNode
+ -> IO ()
+-- Write suitable dependencies to handle
+-- Always:
+-- this.o : this.hs
+--
+-- If the dependency is on something other than a .hi file:
+-- this.o this.p_o ... : dep
+-- otherwise
+-- this.o ... : dep.hi
+-- this.p_o ... : dep.p_hi
+-- ...
+-- (where .o is $osuf, and the other suffixes come from
+-- the cmdline -s options).
+--
+-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
+
+processDeps _ hsc_env _ _ (CyclicSCC nodes)
+ = -- There shouldn't be any cycles; report them
+ throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes
+
+processDeps _ hsc_env _ _ (AcyclicSCC (InstantiationNode _uid node))
+ = -- There shouldn't be any backpack instantiations; report them as well
+ throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $
+ mkPlainErrorMsgEnvelope noSrcSpan $
+ GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
+
+processDeps _dflags _ _ _ (AcyclicSCC (LinkNode {})) = return ()
+processDeps _dflags _ _ _ (AcyclicSCC (UnitNode {})) = return ()
+processDeps _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
+ -- No dependencies needed for fixed modules (already compiled)
+ = return ()
+
+processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do
+ pp <- preprocessor
+ let
+ dep_node = mkDepNode pp
+ find_deps imps = do
+ cpp_deps <- find_cpp_deps
+ import_deps <- find_import_deps imps
+ pure $ map Right cpp_deps ++ import_deps
+ (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node)
+
+ if null missing_dep_errs
+ then do
+ traverse_ (\ (SomeActiveDependencyWriter (writer, backend)) -> dw_writeDependency writer backend dep_node deps) backends
+ else do
+ let sec = initSourceErrorContext (hsc_dflags hsc_env)
+ throwErrors sec (mkMessages (listToBag missing_dep_errs))
+ where
+ src_file = msHsFilePath node
+ mkDepNode preproc =
+ DepNode {
+ dn_mod = ms_mod node,
+ dn_src = src_file,
+ dn_obj = msObjFilePath node,
+ dn_hi = msHiFilePath node,
+ dn_boot = isBootSummary node,
+ dn_preprocessing = preproc
+ }
+
+ preprocessor :: IO PreprocessingNode
+ preprocessor
+ | Just src <- ml_hs_file (ms_location node)
+ = runPipeline (hsc_hooks hsc_env) $ do
+ let (_, suffix) = splitExtension src
+ lit | Unlit _ <- startPhase suffix = True
+ | otherwise = False
+ pipe_env = mkPipeEnv StopPreprocess src Nothing NoOutputFile
+ unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env src) else pure src
+ (dflags1, opts, _, _) <- use (T_FileArgs (hsc_logger hsc_env) (hsc_dflags hsc_env) unlit_fn)
+ let pp = pgm_F dflags1
+ pure PreprocessingNode
+ { pn_preprocessor = if null pp then global_preprocessor else Just pp
+ , pn_options = opts
+ }
+ | otherwise
+ = pure PreprocessingNode
+ { pn_preprocessor = global_preprocessor
+ , pn_options = []
+ }
+
+ global_preprocessor :: Maybe String
+ global_preprocessor
+ | let pp = pgm_F dflags
+ , not (null pp)
+ = Just pp
+ | otherwise
+ = Nothing
+
+ -- Emit a dependency for each CPP import
+ -- CPP deps are discovered in the module parsing phase by parsing
+ -- comment lines left by the preprocessor.
+ -- Note that GHC.parseModule may throw an exception if the module
+ -- fails to parse, which may not be desirable (see #16616).
+ find_cpp_deps :: IO [Dep]
+ find_cpp_deps = do
+ session <- Session <$> newIORef hsc_env
+ parsedMod <- reflectGhc (GHC.parseModule node) session
+ pure (DepCpp <$> GHC.pm_extra_src_files parsedMod)
+
+ -- Emit a dependency for each import
+ find_import_deps :: [UnresolvedImport PkgQual] -> IO [Either (MsgEnvelope GhcMessage) Dep]
+ find_import_deps idecls =
+ sequence
+ [ findDependency hsc_env decl
+ | decl <- idecls
+ , let L _loc mod = ui_mod_name decl
+ , not $ mod `UniqSet.elementOfUniqSet` excl_mods
+ ]
+
+findDependency :: HscEnv
+ -> UnresolvedImport PkgQual -- The import to find
+ -> IO (Either (MsgEnvelope GhcMessage) Dep) -- Interface file
+findDependency hsc_env imp = do
+ -- Find the module; this will be fast because
+ -- we've done it once during downsweep.
+ r <- resolveImport hsc_env imp
+ case r of
+ Found loc dep_mod ->
+ pure $ Right
+ DepHi
+ { dep_mod = dep_mod
+ , dep_path = ml_hi_file loc
+ , dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod)
+ , dep_local = isJust (ml_hs_file loc)
+ , dep_boot = is_boot
+ }
+
+ fail ->
+ return $
+ Left $
+ mkPlainErrorMsgEnvelope srcloc $
+ GhcDriverMessage $ DriverInterfaceError $
+ (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot))
+ where
+ L srcloc mod_name = ui_mod_name imp
+ is_boot = ui_boot imp
+
-----------------------------------------------------------------
--
-- beginMkDependHs
@@ -136,6 +370,14 @@ doMkDependModuleGraph dflags module_graph = do
--
-----------------------------------------------------------------
+initFileDepWriter :: Logger -> FilePath -> TmpFs -> DynFlags -> DependencyWriter MkDepFiles
+initFileDepWriter logger root tmpfs dflags = DependencyWriter
+ { dw_beginWriter = beginMkDependHS logger tmpfs dflags
+ , dw_writeDependency = \ backend node deps -> do
+ writeDependencies (depIncludePkgDeps dflags) root (mkd_tmp_hdl backend) (depSuffixes dflags) node deps
+ , dw_endWriter = endMkDependHS logger
+ }
+
data MkDepFiles
= MkDep { mkd_make_file :: FilePath, -- Name of the makefile
mkd_make_hdl :: Maybe Handle, -- Handle for the open makefile
@@ -188,138 +430,54 @@ beginMkDependHS logger tmpfs dflags = do
return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl,
mkd_tmp_file = tmp_file, mkd_tmp_hdl = tmp_hdl})
+writeDependencies ::
+ Bool ->
+ FilePath ->
+ Handle ->
+ [FilePath] ->
+ DepNode ->
+ [Dep] ->
+ IO ()
+writeDependencies include_pkgs root hdl suffixes node deps =
+ traverse_ write tasks
+ where
+ tasks = source_dep : boot_dep ++ concatMap import_dep deps
+
+ -- Emit std dependency of the object(s) on the source file
+ -- Something like A.o : A.hs
+ source_dep = (obj_files, dn_src)
+
+ -- add dependency between objects and their corresponding .hi-boot
+ -- files if the module has a corresponding .hs-boot file (#14482)
+ boot_dep
+ | IsBoot <- dn_boot
+ = [([obj], hi) | (obj, hi) <- zip (suffixed (viaOsPath removeBootSuffix dn_obj)) (suffixed dn_hi)]
+ | otherwise
+ = []
+
+ -- Add one dependency for each suffix;
+ -- e.g. A.o : B.hi
+ -- A.x_o : B.x_hi
+ import_dep = \case
+ DepHi {dep_path, dep_boot, dep_unit}
+ | isNothing dep_unit || include_pkgs
+ , let path = if dep_boot == IsBoot then viaOsPath addBootSuffix dep_path else dep_path
+ -> [([obj], hi) | (obj, hi) <- zip obj_files (suffixed path)]
------------------------------------------------------------------
---
--- processDeps
---
------------------------------------------------------------------
-
-processDeps :: DynFlags
- -> HscEnv
- -> [ModuleName]
- -> FilePath
- -> Handle -- Write dependencies to here
- -> SCC ModuleGraphNode
- -> IO ()
--- Write suitable dependencies to handle
--- Always:
--- this.o : this.hs
---
--- If the dependency is on something other than a .hi file:
--- this.o this.p_o ... : dep
--- otherwise
--- this.o ... : dep.hi
--- this.p_o ... : dep.p_hi
--- ...
--- (where .o is $osuf, and the other suffixes come from
--- the cmdline -s options).
---
--- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
-
-processDeps _ hsc_env _ _ _ (CyclicSCC nodes)
- = -- There shouldn't be any cycles; report them
- throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $ cyclicModuleErr nodes
-
-processDeps _ hsc_env _ _ _ (AcyclicSCC (InstantiationNode _uid node))
- = -- There shouldn't be any backpack instantiations; report them as well
- throwOneError (initSourceErrorContext (hsc_dflags hsc_env)) $
- mkPlainErrorMsgEnvelope noSrcSpan $
- GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
-
-processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
-processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return ()
-processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
- -- No dependencies needed for fixed modules (already compiled)
- = return ()
-processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node)))
- = do { let extra_suffixes = depSuffixes dflags
- include_pkg_deps = depIncludePkgDeps dflags
- src_file = msHsFilePath node
- obj_file = msObjFilePath node
- obj_files = insertSuffixes obj_file extra_suffixes
-
-
-
- -- Emit std dependency of the object(s) on the source file
- -- Something like A.o : A.hs
- ; writeDependency root hdl obj_files src_file
-
- -- add dependency between objects and their corresponding .hi-boot
- -- files if the module has a corresponding .hs-boot file (#14482)
- ; when (isBootSummary node == IsBoot) $ do
- let hi_boot = msHiFilePath node
- let obj = unsafeDecodeUtf $ removeBootSuffix (msObjFileOsPath node)
- forM_ extra_suffixes $ \suff -> do
- let way_obj = insertSuffixes obj [suff]
- let way_hi_boot = insertSuffixes hi_boot [suff]
- mapM_ (writeDependency root hdl way_obj) way_hi_boot
-
- -- Emit a dependency for each CPP import
- ; when (depIncludeCppDeps dflags) $ do
- -- CPP deps are discovered in the module parsing phase by parsing
- -- comment lines left by the preprocessor.
- -- Note that GHC.parseModule may throw an exception if the module
- -- fails to parse, which may not be desirable (see #16616).
- { session <- Session <$> newIORef hsc_env
- ; parsedMod <- reflectGhc (GHC.parseModule node) session
- ; mapM_ (writeDependency root hdl obj_files)
- (GHC.pm_extra_src_files parsedMod)
- }
-
- -- Emit a dependency for each import
+ | otherwise
+ -> []
- ; let find_deps imps = sequence
- [ findDependency hsc_env imp include_pkg_deps
- | imp <- imps
- , unLoc (ui_mod_name imp) `notElem` excl_mods
- ]
+ DepCpp {dep_path} -> [(obj_files, dep_path)]
- do_imp hi_file = do
- let hi_files = insertSuffixes hi_file extra_suffixes
- write_dep (obj,hi) = writeDependency root hdl [obj] hi
+ write (from, to) = writeDependency root hdl from to
- -- Add one dependency for each suffix;
- -- e.g. A.o : B.hi
- -- A.x_o : B.x_hi
- mapM_ write_dep (obj_files `zip` hi_files)
+ obj_files = suffixed dn_obj
- ; (missing_dep_errs, deps) <- partitionEithers <$> find_deps (ms_imps node)
+ suffixed f = insertSuffixes f suffixes
- ; if null missing_dep_errs
- then mapM_ (mapM_ do_imp) deps
- else do
- let sec = initSourceErrorContext (hsc_dflags hsc_env)
- throwErrors sec (mkMessages (listToBag missing_dep_errs))
- }
+ DepNode {dn_src, dn_obj, dn_hi, dn_boot} = node
-findDependency :: HscEnv
- -> UnresolvedImport PkgQual -- The import to find
- -> Bool -- Record dependency on package modules
- -> IO (Either (MsgEnvelope GhcMessage) (Maybe FilePath)) -- Interface file
-findDependency hsc_env imp include_pkg_deps = do
- -- Find the module; this will be fast because
- -- we've done it once during downsweep.
- r <- resolveImport hsc_env imp
- case r of
- Found loc _
- -- Home package: just depend on the .hi or hi-boot file
- | isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Right (Just (ml_hi_file loc)))
-
- -- Not in this package: we don't need a dependency
- | otherwise
- -> return (Right Nothing)
-
- fail ->
- return $
- Left $
- mkPlainErrorMsgEnvelope srcloc $
- GhcDriverMessage $ DriverInterfaceError $
- (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot))
- where
- L srcloc mod_name = ui_mod_name imp
- is_boot = ui_boot imp
+ viaOsPath f a = unsafeDecodeUtf (f (unsafeEncodeUtf a))
-----------------------------
writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
@@ -328,7 +486,7 @@ writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
writeDependency root hdl targets dep
= do let -- We need to avoid making deps on
-- c:/foo/...
- -- on Windows as make gets confused by the :
+ -- on cygwin as make gets confused by the :
-- Making relative deps avoids some instances of this.
dep' = makeRelative root dep
forOutput = escapeSpaces . reslash Forwards . normalise
@@ -352,11 +510,8 @@ insertSuffixes file_name extras
-----------------------------------------------------------------
---
--- endMkDependHs
--- Complete the makefile, close the tmp file etc
---
------------------------------------------------------------------
+-- endMkDependHs
+-- Complete the makefile, close the tmp file etc
endMkDependHS :: Logger -> MkDepFiles -> IO ()
@@ -385,6 +540,183 @@ endMkDependHS logger
showPass logger "Installing new makefile"
SysTools.copyFile tmp_file makefile
+-----------------------------------------------------------------
+--
+-- JSON MkDepends output
+--
+-----------------------------------------------------------------
+
+initJsonDepWriter :: FilePath -> DynFlags -> DependencyWriter (JsonOutput DepJson)
+initJsonDepWriter output dflags = DependencyWriter
+ { dw_beginWriter = do
+ mkJsonOutput output initDepJson
+ , dw_writeDependency = \ backend node deps -> do
+ updateJson backend (updateDepJson (depIncludePkgDeps dflags) node deps)
+ , dw_endWriter =
+ writeJsonOutput
+ }
+
+--------------------------------------------------------------------------------
+-- Output interface for json dumps
+
+-- | Resources for a json dump option, used in "GHC.Driver.MakeFile".
+-- The flag @-dep-json@ add an additional output target for dependency
+-- diagnostics.
+data JsonOutput a =
+ JsonOutput {
+ -- | This ref is updated in @processDeps@ incrementally, using a
+ -- flag-specific type.
+ json_ref :: IORef a,
+
+ -- | The output file path specified as argument to the flag.
+ json_path :: FilePath
+ }
+
+-- | TODO: @fendor
+mkJsonOutput ::
+ FilePath ->
+ IO (IORef a) ->
+ IO (JsonOutput a)
+mkJsonOutput json_path mk_ref = do
+ json_ref <- mk_ref
+ pure JsonOutput {json_ref, json_path}
+
+-- | Update the dump data in 'json_ref' if the output target is present.
+updateJson :: JsonOutput a -> (a -> a) -> IO ()
+updateJson JsonOutput {json_ref} f = modifyIORef' json_ref f
+
+-- | Write a json object to the flag-dependent file if the output target is
+-- present.
+writeJsonOutput ::
+ ToJson a =>
+ JsonOutput a ->
+ IO ()
+writeJsonOutput JsonOutput {json_ref, json_path} = do
+ payload <- readIORef json_ref
+ writeJsonFile payload json_path
+
+--------------------------------------------------------------------------------
+-- Output helpers
+
+writeJsonFile :: ToJson a => a -> FilePath -> IO ()
+writeJsonFile doc p = do
+ withAtomicRename p
+ $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc
+
+--------------------------------------------------------------------------------
+-- Payload for -dep-json
+
+newtype PackageDeps
+ = PackageDeps (Map.Map (String, UnitId, DPackageId) (Set.Set ModuleName))
+ deriving newtype (Monoid)
+
+newtype DPackageId = DPackageId PackageId
+ deriving newtype (Eq)
+
+instance Ord DPackageId where
+ DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2
+
+instance Semigroup PackageDeps where
+ PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r)
+
+data Deps
+ = Deps
+ { sources :: Set.Set FilePath
+ , modules :: (Set.Set ModuleName, Set.Set ModuleName)
+ , packages :: PackageDeps
+ , cpp :: Set.Set FilePath
+ , options :: [String]
+ , preprocessor :: Maybe FilePath
+ }
+ deriving stock (Generic)
+ deriving (Semigroup, Monoid) via (Generically Deps)
+
+newtype DepJson = DepJson (Map.Map ModuleName Deps)
+
+instance ToJson DepJson where
+ json (DepJson m) =
+ JSObject [
+ (moduleNameString target, JSObject [
+ ("sources", array sources normalise),
+ ("modules", array (fst modules) moduleNameString),
+ ("modules-boot", array (snd modules) moduleNameString),
+ ("packages",
+ JSArray
+ [ package name unit_id package_id mods
+ | ((name, unit_id, dpkd_id), mods) <- Map.toList packages
+ , let DPackageId package_id = dpkd_id
+ ]
+ ),
+ ("cpp", array cpp id),
+ ("options", JSArray $ map JSString options),
+ ("preprocessor", maybe JSNull JSString preprocessor)
+ ])
+ | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m
+ ]
+ where
+ package name unit_id (PackageId package_id) mods =
+ JSObject [
+ ("id", JSString (unitIdString unit_id)),
+ ("name", JSString name),
+ ("package-id", JSString (unpackFS package_id)),
+ ("modules", array mods moduleNameString)
+ ]
+
+ array values render = JSArray (fmap (JSString . render) (Set.toList values))
+
+initDepJson :: IO (IORef DepJson)
+initDepJson = newIORef $ DepJson Map.empty
+
+insertDepJson :: [ModuleName] -> Deps -> DepJson -> DepJson
+insertDepJson targets dep (DepJson m0) =
+ DepJson
+ $ foldl'
+ ( \acc target ->
+ Map.insertWith
+ (Semigroup.<>)
+ target
+ dep
+ acc
+ )
+ m0
+ targets
+
+updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson
+updateDepJson include_pkgs DepNode {..} deps =
+ insertDepJson [moduleName dn_mod] payload
+ where
+ payload = node_data Semigroup.<> foldMap dep deps
+
+ node_data =
+ mempty {
+ sources = Set.singleton dn_src,
+ preprocessor = pn_preprocessor dn_preprocessing,
+ options = pn_options dn_preprocessing
+ }
+
+ dep = \case
+ DepHi {dep_mod, dep_local, dep_unit, dep_boot}
+ | dep_local
+ , let set = Set.singleton $ moduleName dep_mod
+ value | IsBoot <- dep_boot = (Set.empty, set)
+ | otherwise = (set, Set.empty)
+ -> mempty {modules = value}
+
+ | include_pkgs
+ , Just unit <- dep_unit
+ , let PackageName nameFS = unitPackageName unit
+ name = unpackFS nameFS
+ withLibName (PackageName c) = name ++ ":" ++ unpackFS c
+ lname = maybe name withLibName (unitComponentName unit)
+ key = (lname, unitId unit, DPackageId $ unitPackageId unit)
+ -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton $ moduleName dep_mod))}
+
+ | otherwise
+ -> mempty
+
+ DepCpp {dep_path} ->
+ mempty {cpp = Set.singleton dep_path}
+
-----------------------------------------------------------------
-- Module cycles
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -820,13 +820,13 @@ preprocessPipeline pipe_env hsc_env input_fn = do
use (T_Unlit pipe_env hsc_env input_fn)
- (dflags1, p_warns1, warns1) <- use (T_FileArgs hsc_env unlit_fn)
+ (dflags1, _, p_warns1, warns1) <- use (fileArgsPhase hsc_env unlit_fn)
let hsc_env1 = hscSetFlags dflags1 hsc_env
(cpp_fn, hsc_env2)
<- runAfterFlag hsc_env1 (Cpp HsSrcFile) (xopt LangExt.Cpp) (unlit_fn, hsc_env1) $ do
cpp_fn <- use (T_Cpp pipe_env hsc_env1 unlit_fn)
- (dflags2, _, _) <- use (T_FileArgs hsc_env1 cpp_fn)
+ (dflags2, _, _, _) <- use (fileArgsPhase hsc_env1 cpp_fn)
let hsc_env2 = hscSetFlags dflags2 hsc_env1
return (cpp_fn, hsc_env2)
@@ -841,7 +841,8 @@ preprocessPipeline pipe_env hsc_env input_fn = do
then return (dflags1, p_warns1, warns1)
else do
-- Reparse with original hsc_env so that we don't get duplicated options
- use (T_FileArgs hsc_env pp_fn)
+ (dflagsPP, _, p_warns3, warns3) <- use (fileArgsPhase hsc_env pp_fn)
+ pure (dflagsPP, p_warns3, warns3)
let print_config = initPrintConfig dflags3
liftIO (printOrThrowDiagnostics (hsc_logger hsc_env) print_config (initDiagOpts dflags3) (GhcPsMessage <$> p_warns3))
@@ -865,6 +866,9 @@ preprocessPipeline pipe_env hsc_env input_fn = do
runAfter phase def
$ phaseIfFlag hsc_env flag def action
+ fileArgsPhase env fn =
+ T_FileArgs (hsc_logger env) (hsc_dflags env) fn
+
-- | The complete compilation pipeline, from start to finish
fullPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> HscSource -> m (ModIface, RecompLinkables)
fullPipeline pipe_env hsc_env pp_fn src_flavour = do
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -104,7 +104,7 @@ runPhase :: TPhase out -> IO out
runPhase (T_Unlit pipe_env hsc_env inp_path) = do
out_path <- phaseOutputFilenameNew (Cpp HsSrcFile) pipe_env hsc_env Nothing
runUnlitPhase hsc_env inp_path out_path
-runPhase (T_FileArgs hsc_env inp_path) = getFileArgs hsc_env inp_path
+runPhase (T_FileArgs logger dflags inp_path) = getFileArgsNoHsc logger dflags inp_path
runPhase (T_Cpp pipe_env hsc_env inp_path) = do
out_path <- phaseOutputFilenameNew (HsPp HsSrcFile) pipe_env hsc_env Nothing
runCppPhase hsc_env inp_path out_path
@@ -620,17 +620,21 @@ runUnlitPhase hsc_env input_fn output_fn = do
return output_fn
-getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, Messages PsMessage, Messages DriverMessage))
+getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
getFileArgs hsc_env input_fn = do
let dflags0 = hsc_dflags hsc_env
logger = hsc_logger hsc_env
- parser_opts = initParserOpts dflags0
+ getFileArgsNoHsc logger dflags0 input_fn
+
+getFileArgsNoHsc :: Logger -> DynFlags -> FilePath -> IO ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
+getFileArgsNoHsc logger dflags0 input_fn = do
+ let parser_opts = initParserOpts dflags0
sec = initSourceErrorContext dflags0
(warns0, src_opts) <- getOptionsFromFile parser_opts sec (supportedLanguagePragmas dflags0) input_fn
(dflags1, unhandled_flags, warns)
<- parseDynamicFilePragma logger dflags0 src_opts
checkProcessArgsResult dflags0 unhandled_flags
- return (dflags1, warns0, warns)
+ return (dflags1, map unLoc src_opts, warns0, warns)
runCppPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
runCppPhase hsc_env input_fn output_fn = do
=====================================
compiler/GHC/Driver/Pipeline/Phases.hs
=====================================
@@ -13,6 +13,7 @@ import GHC.Driver.Errors.Types
import GHC.Fingerprint.Type
import GHC.Unit.Module.Location ( ModLocation )
import GHC.Unit.Module.ModIface
+import GHC.Utils.Logger
import GHC.Driver.Phases
import Language.Haskell.Syntax.Module.Name ( ModuleName )
@@ -25,7 +26,7 @@ import GHC.Unit.Home.ModInfo
-- phase if the inputs have been modified.
data TPhase res where
T_Unlit :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
- T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, Messages PsMessage, Messages DriverMessage)
+ T_FileArgs :: Logger -> DynFlags -> FilePath -> TPhase ((DynFlags, [String], Messages PsMessage, Messages DriverMessage))
T_Cpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_HsPp :: PipeEnv -> HscEnv -> FilePath -> FilePath -> TPhase FilePath
T_HscRecomp :: PipeEnv -> HscEnv -> FilePath -> HscSource -> TPhase (HscEnv, ModSummary, HscRecompStatus)
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -760,6 +760,9 @@ addOptCmmP f = alterToolSettings $ \s -> s
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = f }
+setDepJson :: FilePath -> DynFlags -> DynFlags
+setDepJson f d = d { depJson = Just f }
+
setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
@@ -1245,6 +1248,7 @@ dynamic_flags_deps = [
-------- ghc -M -----------------------------------------------------
, make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix)
, make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile)
+ , make_ord_flag defGhcFlag "dep-json" (hasArg setDepJson)
, make_ord_flag defGhcFlag "include-cpp-deps"
(noArg (setDepIncludeCppDeps True))
, make_ord_flag defGhcFlag "include-pkg-deps"
=====================================
testsuite/tests/driver/T24384/A.hs
=====================================
@@ -0,0 +1,5 @@
+{-# language Strict #-}
+{-# options_ghc -fexpose-all-unfoldings #-}
+module A where
+
+import {-# source #-} C
=====================================
testsuite/tests/driver/T24384/C.hs
=====================================
@@ -0,0 +1,6 @@
+module C where
+
+import A
+import Data.Set
+
+data C = C
=====================================
testsuite/tests/driver/T24384/C.hs-boot
=====================================
@@ -0,0 +1,5 @@
+module C where
+
+import E
+
+data C
=====================================
testsuite/tests/driver/T24384/D.hs
=====================================
@@ -0,0 +1,4 @@
+module D where
+
+import B
+import C
=====================================
testsuite/tests/driver/T24384/E.hs
=====================================
@@ -0,0 +1,14 @@
+module E where
+
+import Language.Haskell.TH.Syntax
+import Dep
+import DepPublic
+
+e :: Q Exp
+e = lift (5 :: Integer)
+
+edep :: ()
+edep = dep
+
+edepPub :: ()
+edepPub = depPub
=====================================
testsuite/tests/driver/T24384/Makefile
=====================================
@@ -0,0 +1,38 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+
+PKGCONF_LOCAL=./db.package.conf
+GHC_PKG_LOCAL='$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_LOCAL)
+
+T24384:
+ $(GHC_PKG_LOCAL) init $(PKGCONF_LOCAL) 2>&1 >/dev/null
+
+ cd dep-internal && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-internal-1-XXX \
+ -package base \
+ -i. DepInternal
+ $(GHC_PKG_LOCAL) register --force dep-internal/dep-internal.pkg 2>&1 >/dev/null
+
+ cd dep-public && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-public-1-XXX \
+ -package base \
+ -i. DepPublic
+ $(GHC_PKG_LOCAL) register --force dep-public/dep-public.pkg 2>&1 >/dev/null
+
+ cd dep && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-1-XXX \
+ -package-db ../$(PKGCONF_LOCAL) -package-id dep-internal-1-XXX \
+ -i. Dep
+ $(GHC_PKG_LOCAL) register --force dep/dep.pkg 2>&1 >/dev/null
+
+ '$(TEST_HC)' -M -dep-json dep.json -include-pkg-deps -include-cpp-deps \
+ -hide-all-packages -package base -package containers -package template-haskell \
+ -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \
+ A.hs lib/B.hs C.hs D.hs E.hs
+
+ cat dep.json | jq --sort-keys
=====================================
testsuite/tests/driver/T24384/T24384.stdout
=====================================
@@ -0,0 +1,157 @@
+{
+ "A": {
+ "cpp": [],
+ "modules": [],
+ "modules-boot": [
+ "C"
+ ],
+ "options": [
+ "-XStrict",
+ "-fexpose-all-unfoldings"
+ ],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "A.hs"
+ ]
+ },
+ "B": {
+ "cpp": [],
+ "modules": [
+ "A"
+ ],
+ "modules-boot": [],
+ "options": [
+ "-F",
+ "-pgmF",
+ "./preproc.sh"
+ ],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": "./preproc.sh",
+ "sources": [
+ "lib/B.hs"
+ ]
+ },
+ "C": {
+ "cpp": [],
+ "modules": [
+ "A",
+ "E"
+ ],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ },
+ {
+ "id": "containers-0.8-inplace",
+ "modules": [
+ "Data.Set"
+ ],
+ "name": "containers",
+ "package-id": "containers-0.8"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "C.hs",
+ "C.hs-boot"
+ ]
+ },
+ "D": {
+ "cpp": [],
+ "modules": [
+ "B",
+ "C"
+ ],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "D.hs"
+ ]
+ },
+ "E": {
+ "cpp": [],
+ "modules": [],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ },
+ {
+ "id": "dep-1-XXX",
+ "modules": [
+ "Dep"
+ ],
+ "name": "dep",
+ "package-id": "dep-1"
+ },
+ {
+ "id": "dep-public-1-XXX",
+ "modules": [
+ "DepPublic"
+ ],
+ "name": "dep-public",
+ "package-id": "dep-public-1"
+ },
+ {
+ "id": "template-haskell-2.25.0.0-inplace",
+ "modules": [
+ "Language.Haskell.TH.Syntax"
+ ],
+ "name": "template-haskell",
+ "package-id": "template-haskell-2.25.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "E.hs"
+ ]
+ }
+}
=====================================
testsuite/tests/driver/T24384/all.T
=====================================
@@ -0,0 +1,7 @@
+test('T24384',
+ [ extra_files(['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs',
+ 'dep', 'dep-internal', 'dep-public',
+ 'preproc.sh'
+ ])
+ ],
+ makefile_test, [])
=====================================
testsuite/tests/driver/T24384/dep-internal/DepInternal.hs
=====================================
@@ -0,0 +1,3 @@
+module DepInternal where
+depInt :: ()
+depInt = ()
=====================================
testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep-internal
+version: 1
+id: dep-internal-1-XXX
+key: dep-internal-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: DepInternal
+depends:
+import-dirs: ${pkgroot}/dep-internal/outdir
+library-dirs: ${pkgroot}/dep-internal/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/dep-public/DepPublic.hs
=====================================
@@ -0,0 +1,3 @@
+module DepPublic where
+depPub :: ()
+depPub = ()
=====================================
testsuite/tests/driver/T24384/dep-public/dep-public.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep-public
+version: 1
+id: dep-public-1-XXX
+key: dep-public-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: DepPublic
+depends:
+import-dirs: ${pkgroot}/dep-public/outdir
+library-dirs: ${pkgroot}/dep-public/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/dep/Dep.hs
=====================================
@@ -0,0 +1,4 @@
+module Dep where
+import DepInternal
+dep :: ()
+dep = depInt
=====================================
testsuite/tests/driver/T24384/dep/dep.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep
+version: 1
+id: dep-1-XXX
+key: dep-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: Dep
+depends: dep-internal-1-XXX
+import-dirs: ${pkgroot}/dep/outdir
+library-dirs: ${pkgroot}/dep/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/lib/B.hs
=====================================
@@ -0,0 +1,2 @@
+{-# options_ghc -F -pgmF ./preproc.sh #-}
+module B where
=====================================
testsuite/tests/driver/T24384/preproc.sh
=====================================
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+
+sed '/preproc/d' $2 > $3
+echo 'import A' >> $3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2808bf6781bd97504c20d86381962e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2808bf6781bd97504c20d86381962e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Simon Peyton Jones pushed to branch wip/T27737 at Glasgow Haskell Compiler / GHC
Commits:
4aff53c1 by Simon Peyton Jones at 2026-09-22T15:36:53+01:00
Try another way
let's see what CI says
- - - - -
1 changed file:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1282,11 +1282,12 @@ simplExprF1 env expr@(Lam {}) cont
-- NB: countArgs counts all the args (incl type args)
-- and likewise drop counts all binders (incl type lambdas)
-simplExprF1 env (Case scrut bndr _ alts) cont
+simplExprF1 env expr@(Case scrut bndr _ alts) cont
| not (seCaseCase env) -- See (COC-INV) in Note [sm_case_case: switching off case continuations]
- = do { let scrut_out_ty = substTy env (idType bndr)
- ; scrut' <- simplExprC env scrut (mkBoringStop scrut_out_ty)
- ; rebuildCase (SAF_In, env) scrut' bndr alts cont }
+ , (inner, outer) <- splitContArgs cont
+ , not (contIsStop outer)
+ = do { expr' <- simplExprC env expr inner
+ ; rebuild env expr' outer }
| otherwise
= {-#SCC "simplExprF1-Case" #-}
@@ -1318,11 +1319,19 @@ simplExprF1 env (Let bind body) cont
| Just bind' <- joinPointBind_maybe bind
= simplJoinPointBind env bind' body cont
+simplExprF1 env expr@(Let {}) cont
+ | not (seCaseCase env)
+ , (inner, outer) <- splitContArgs cont
+ , not (contIsStop outer)
+ = do { expr' <- simplExprC env expr inner
+ ; rebuild env expr' outer }
+
-- Non-recursive let
simplExprF1 env (Let (NonRec bndr rhs) body) cont
= {-#SCC "simplNonRecE" #-}
simplNonRecE env FromLet bndr (rhs, env) body cont
+-- Recursive let
simplExprF1 env (Let (Rec pairs) body) cont
= {-#SCC "simplRecE" #-}
simplRecE env pairs body cont
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aff53c1d89a1825c7fae64a57ea3f3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aff53c1d89a1825c7fae64a57ea3f3…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/fendor/dep-json] 3 commits: Add json output format
by Hannes Siebenhandl (＠fendor) 22 Sep '26
by Hannes Siebenhandl (＠fendor) 22 Sep '26
22 Sep '26
Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC
Commits:
e0d006a4 by fendor at 2026-09-22T16:21:48+02:00
Add json output format
- - - - -
c9b90413 by fendor at 2026-09-22T16:21:48+02:00
fixup! Refactor Makefile to use phases appropriately
- - - - -
2808bf67 by fendor at 2026-09-22T16:21:48+02:00
Add -dep-json test with multiple deps
- - - - -
19 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Session.hs
- + testsuite/tests/driver/T24384/A.hs
- + testsuite/tests/driver/T24384/C.hs
- + testsuite/tests/driver/T24384/C.hs-boot
- + testsuite/tests/driver/T24384/D.hs
- + testsuite/tests/driver/T24384/E.hs
- + testsuite/tests/driver/T24384/Makefile
- + testsuite/tests/driver/T24384/T24384.stdout
- + testsuite/tests/driver/T24384/all.T
- + testsuite/tests/driver/T24384/dep-internal/DepInternal.hs
- + testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg
- + testsuite/tests/driver/T24384/dep-public/DepPublic.hs
- + testsuite/tests/driver/T24384/dep-public/dep-public.pkg
- + testsuite/tests/driver/T24384/dep/Dep.hs
- + testsuite/tests/driver/T24384/dep/dep.pkg
- + testsuite/tests/driver/T24384/lib/B.hs
- + testsuite/tests/driver/T24384/preproc.sh
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -351,6 +351,7 @@ data DynFlags = DynFlags {
-- For ghc -M
depMakefile :: FilePath,
+ depJson :: Maybe FilePath,
depIncludePkgDeps :: Bool,
depIncludeCppDeps :: Bool,
depExcludeMods :: [ModuleName],
@@ -694,6 +695,7 @@ defaultDynFlags mySettings =
-- ghc -M values
depMakefile = "Makefile",
+ depJson = Nothing,
depIncludePkgDeps = False,
depIncludeCppDeps = False,
depExcludeMods = [],
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -7,6 +7,8 @@
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE RecordWildCards #-}
module GHC.Driver.MakeFile
( doMkDependHS
@@ -16,9 +18,10 @@ where
import GHC.Prelude
-
import qualified GHC
+import GHC.Data.Bag (listToBag)
+import GHC.Data.FastString
import GHC.Data.Graph.Directed (SCC (..))
import GHC.Data.OsPath (unsafeDecodeUtf, unsafeEncodeUtf)
@@ -35,12 +38,12 @@ import GHC.Driver.Session
import GHC.Iface.Errors.Types
import GHC.Iface.Load (cannotFindModule)
-import qualified GHC.SysTools as SysTools
+import GHC.SysTools qualified as SysTools
import GHC.Types.PkgQual
import GHC.Types.SourceError
import GHC.Types.SrcLoc
import GHC.Types.Unique.Set (UniqSet)
-import qualified GHC.Types.Unique.Set as UniqSet
+import GHC.Types.Unique.Set qualified as UniqSet
import GHC.Types.UnresolvedImport
import GHC.Unit.Finder
@@ -52,23 +55,27 @@ import GHC.Unit.State (lookupUnitId)
import GHC.Utils.Error
import GHC.Utils.Exception
+import GHC.Utils.Json
import GHC.Utils.Logger
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.TmpFs
-import System.Directory
-import System.FilePath
-import System.IO
-import System.IO.Error (isEOFError)
import Control.Monad (when)
import Data.Either
import Data.Foldable (traverse_)
import Data.IORef
import Data.List (partition)
+import Data.Map.Strict qualified as Map
import Data.Maybe (isJust, isNothing)
+import Data.Semigroup qualified as Semigroup
import Data.Set qualified as Set
+import GHC.Generics (Generic, Generically (..))
+import System.Directory
+import System.FilePath
+import System.IO
+import System.IO.Error (isEOFError)
-----------------------------------------------------------------
--
@@ -117,7 +124,15 @@ doMkDependModuleGraph dflags module_graph = do
excl_mods = depExcludeMods dflags
root <- liftIO getCurrentDirectory
- let dep_writer = initFileDepWriter logger root tmpfs dflags
+ let
+ dep_writers =
+ concat
+ [ [ SomeDependencyWriter $ initFileDepWriter logger root tmpfs dflags
+ ]
+ , [ SomeDependencyWriter $ initJsonDepWriter json_output dflags
+ | Just json_output <- [depJson dflags]
+ ]
+ ]
let sorted = GHC.topSortModuleGraph False module_graph Nothing
@@ -125,12 +140,25 @@ doMkDependModuleGraph dflags module_graph = do
liftIO $ debugTraceMsg logger 2 (text "Module dependencies" $$ ppr sorted)
liftIO $ bracket
- (dw_beginWriter dep_writer)
+ (do
+ traverse
+ (\ (SomeDependencyWriter dep_writer) -> do
+ backend <- dw_beginWriter dep_writer
+ pure (SomeDependencyWriter2 (dep_writer, backend))
+ )
+ dep_writers
+ )
-- Tidy up
- (dw_endWriter dep_writer)
- ( \ files -> do
+ (\ writers -> do
+ traverse
+ ( \(SomeDependencyWriter2 (writer, backend)) ->
+ dw_endWriter writer backend
+ )
+ writers
+ )
+ ( \ backends -> do
-- Process them one by one, dumping results and complaining about cycles
- mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) [(dep_writer, files)]) sorted
+ mapM_ (processDeps dflags hsc_env (UniqSet.mkUniqSet excl_mods) backends) sorted
-- If -ddump-mod-cycles, show cycles in the module graph
liftIO $ dumpModCycles logger module_graph
@@ -147,28 +175,41 @@ doMkDependModuleGraph dflags module_graph = do
-- Types abstracting over the output
--------------------------------------------------------------------------------
-data DepNode
- = DepNode {
- dn_mod :: Module,
- dn_src :: FilePath,
- dn_obj :: FilePath,
- dn_hi :: FilePath,
- dn_boot :: IsBootInterface,
- dn_options :: [String]
+data DepNode =
+ DepNode
+ { dn_mod :: Module
+ , dn_src :: FilePath
+ , dn_obj :: FilePath
+ , dn_hi :: FilePath
+ , dn_boot :: IsBootInterface
+ , dn_preprocessor :: PreprocessorInfo
+ }
+
+data PreprocessorInfo =
+ PreprocessorInfo
+ { pi_options :: [String]
-- ^ module level @OPTIONS_GHC@ pragma contents
+ , pi_processor :: Maybe FilePath
}
data Dep
- = DepHi {
- dep_mod :: Module,
- dep_path :: FilePath,
- dep_unit :: Maybe UnitInfo,
- dep_local :: Bool,
- dep_boot :: IsBootInterface
+ = DepHi
+ { dep_mod_name :: ModuleName
+ , dep_path :: FilePath
+ , dep_unit :: Maybe UnitInfo
+ , dep_local :: Bool
+ , dep_boot :: IsBootInterface
+ }
+ | DepCpp
+ { dep_path :: FilePath
}
- | DepCpp {
- dep_path :: FilePath
- }
+
+
+data SomeDependencyWriter =
+ forall backend . SomeDependencyWriter (DependencyWriter backend)
+
+data SomeDependencyWriter2 =
+ forall backend . SomeDependencyWriter2 ((DependencyWriter backend, backend))
data DependencyWriter backend = DependencyWriter
{ dw_beginWriter :: IO backend
@@ -185,7 +226,7 @@ data DependencyWriter backend = DependencyWriter
processDeps :: DynFlags
-> HscEnv
-> UniqSet ModuleName -- ^ Excludes
- -> [(DependencyWriter backend, backend)]
+ -> [SomeDependencyWriter2]
-> SCC ModuleGraphNode
-> IO ()
-- Write suitable dependencies to handle
@@ -221,27 +262,40 @@ processDeps _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {})))
processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do
pp <- preprocessor
- let dep_node = mkDepNode (maybe [] snd pp)
- deps <- fmap concat $ sequence $
- [cpp_deps | depIncludeCppDeps dflags] ++ [
- import_deps IsBoot (ms_srcimps node),
- import_deps NotBoot (ms_imps node)
- ]
+ let dep_node = mkDepNode pp
+
+ let
+ find_deps = do
+ cpp_deps <- find_cpp_deps
+ imp_deps <- find_import_deps (ms_imps node)
+ pure $ map Right cpp_deps ++ imp_deps
+
+ (missing_dep_errs, deps) <- partitionEithers <$> find_deps
+
+ if null missing_dep_errs
+ then do
+ traverse_
+ (\ (SomeDependencyWriter2 (writer, backend)) ->
+ dw_writeDependency writer backend dep_node deps
+ )
+ backends
+ else do
+ let sec = initSourceErrorContext (hsc_dflags hsc_env)
+ throwErrors sec (mkMessages (listToBag missing_dep_errs))
- traverse_ (\ (writer, backend) -> dw_writeDependency writer backend dep_node deps) backends
where
src_file = msHsFilePath node
- mkDepNode opts =
+ mkDepNode preproc =
DepNode {
dn_mod = ms_mod node,
dn_src = src_file,
dn_obj = msObjFilePath node,
dn_hi = msHiFilePath node,
dn_boot = isBootSummary node,
- dn_options = opts
+ dn_preprocessor = preproc
}
- preprocessor :: IO (Maybe (String, [String]))
+ preprocessor :: IO PreprocessorInfo
preprocessor
| Just src <- ml_hs_file (ms_location node)
= runPipeline (hsc_hooks hsc_env) $ do
@@ -252,15 +306,23 @@ processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleN
unlit_fn <- if lit then use (T_Unlit pipe_env hsc_env src) else pure src
(dflags1, opts, _, _) <- use (T_FileArgs (hsc_logger hsc_env) (hsc_dflags hsc_env) unlit_fn)
let pp = pgm_F dflags1
- pure (if null pp then global_preprocessor else Just (pp, opts))
+ pure
+ PreprocessorInfo
+ { pi_processor = if null pp then global_preprocessor else Just pp
+ , pi_options = opts
+ }
| otherwise
- = pure global_preprocessor
+ = pure
+ PreprocessorInfo
+ { pi_processor = global_preprocessor
+ , pi_options = []
+ }
- global_preprocessor :: Maybe (String, [String])
+ global_preprocessor :: Maybe String
global_preprocessor
| let pp = pgm_F dflags
, not (null pp)
- = Just (pp, [])
+ = Just pp
| otherwise
= Nothing
@@ -269,53 +331,49 @@ processDeps dflags hsc_env excl_mods backends (AcyclicSCC (ModuleNode _ (ModuleN
-- comment lines left by the preprocessor.
-- Note that GHC.parseModule may throw an exception if the module
-- fails to parse, which may not be desirable (see #16616).
- cpp_deps :: IO [Dep]
- cpp_deps = do
+ find_cpp_deps :: IO [Dep]
+ find_cpp_deps = do
session <- Session <$> newIORef hsc_env
parsedMod <- reflectGhc (GHC.parseModule node) session
pure (DepCpp <$> GHC.pm_extra_src_files parsedMod)
-- Emit a dependency for each import
- import_deps :: IsBootInterface -> [UnresolvedImport PkgQual] -> IO [Dep]
- import_deps is_boot idecls =
- sequence [
- findDependency hsc_env loc mb_pkg mod is_boot
+ find_import_deps :: [UnresolvedImport PkgQual] -> IO [Either (MsgEnvelope GhcMessage) Dep]
+ find_import_deps idecls =
+ sequence
+ [ findDependency hsc_env decl
| decl <- idecls
- , let mb_pkg = ui_pkg_qual decl
- , let L loc mod = ui_mod_name decl
- , mod `UniqSet.elementOfUniqSet` excl_mods
+ , let L _loc mod = ui_mod_name decl
+ , not (mod `UniqSet.elementOfUniqSet` excl_mods)
]
findDependency :: HscEnv
- -> SrcSpan
- -> PkgQual -- package qualifier, if any
- -> ModuleName -- Imported module
- -> IsBootInterface -- Source import
- -> IO Dep
-findDependency hsc_env srcloc pkg imp dep_boot = do
+ -> UnresolvedImport PkgQual -- The import to find
+ -> IO (Either (MsgEnvelope GhcMessage) Dep) -- Interface file
+findDependency hsc_env imp = do
-- Find the module; this will be fast because
-- we've done it once during downsweep
- findImportedModule hsc_env LookupUser imp pkg >>= \case
+ resolveImport hsc_env imp >>= \case
Found loc dep_mod ->
- pure DepHi {
- dep_mod,
- dep_path = ml_hi_file loc,
- dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod),
- dep_local,
- dep_boot
- }
- where
- dep_local = isJust (ml_hs_file loc)
+ pure $ Right
+ DepHi
+ { dep_mod_name = mod_name
+ , dep_path = ml_hi_file loc
+ , dep_unit = lookupUnitId (hsc_units hsc_env) (moduleUnitId dep_mod)
+ , dep_local = isJust (ml_hs_file loc)
+ , dep_boot = is_boot
+ }
fail ->
- throwOneError
- (initSourceErrorContext (hsc_dflags hsc_env)) $
- mkPlainErrorMsgEnvelope srcloc $
- GhcDriverMessage $
- DriverInterfaceError $
- Can'tFindInterface (cannotFindModule hsc_env imp fail) $
- LookingForModule imp dep_boot
+ return $
+ Left $
+ mkPlainErrorMsgEnvelope srcloc $
+ GhcDriverMessage $ DriverInterfaceError $
+ (Can'tFindInterface (cannotFindModule hsc_env mod_name fail) (LookingForModule mod_name is_boot))
+ where
+ L srcloc mod_name = ui_mod_name imp
+ is_boot = ui_boot imp
-----------------------------------------------------------------
@@ -467,11 +525,8 @@ insertSuffixes file_name extras
-----------------------------------------------------------------
---
--- endMkDependHs
--- Complete the makefile, close the tmp file etc
---
------------------------------------------------------------------
+-- endMkDependHs
+-- Complete the makefile, close the tmp file etc
endMkDependHS :: Logger -> MkDepFiles -> IO ()
@@ -500,6 +555,183 @@ endMkDependHS logger
showPass logger "Installing new makefile"
SysTools.copyFile tmp_file makefile
+-----------------------------------------------------------------
+--
+-- JSON MkDepends output
+--
+-----------------------------------------------------------------
+
+initJsonDepWriter :: FilePath -> DynFlags -> DependencyWriter (JsonOutput DepJson)
+initJsonDepWriter output dflags = DependencyWriter
+ { dw_beginWriter = do
+ mkJsonOutput output initDepJson
+ , dw_writeDependency = \ backend node deps -> do
+ updateJson backend (updateDepJson (depIncludePkgDeps dflags) node deps)
+ , dw_endWriter =
+ writeJsonOutput
+ }
+
+--------------------------------------------------------------------------------
+-- Output interface for json dumps
+
+-- | Resources for a json dump option, used in "GHC.Driver.MakeFile".
+-- The flag @-dep-json@ add an additional output target for dependency
+-- diagnostics.
+data JsonOutput a =
+ JsonOutput {
+ -- | This ref is updated in @processDeps@ incrementally, using a
+ -- flag-specific type.
+ json_ref :: IORef a,
+
+ -- | The output file path specified as argument to the flag.
+ json_path :: FilePath
+ }
+
+-- | TODO: @fendor
+mkJsonOutput ::
+ FilePath ->
+ IO (IORef a) ->
+ IO (JsonOutput a)
+mkJsonOutput json_path mk_ref = do
+ json_ref <- mk_ref
+ pure JsonOutput {json_ref, json_path}
+
+-- | Update the dump data in 'json_ref' if the output target is present.
+updateJson :: JsonOutput a -> (a -> a) -> IO ()
+updateJson JsonOutput {json_ref} f = modifyIORef' json_ref f
+
+-- | Write a json object to the flag-dependent file if the output target is
+-- present.
+writeJsonOutput ::
+ ToJson a =>
+ JsonOutput a ->
+ IO ()
+writeJsonOutput JsonOutput {json_ref, json_path} = do
+ payload <- readIORef json_ref
+ writeJsonFile payload json_path
+
+--------------------------------------------------------------------------------
+-- Output helpers
+
+writeJsonFile :: ToJson a => a -> FilePath -> IO ()
+writeJsonFile doc p = do
+ withAtomicRename p
+ $ \tmp -> writeFile tmp $ showSDocUnsafe $ renderJSON $ json doc
+
+--------------------------------------------------------------------------------
+-- Payload for -dep-json
+
+newtype PackageDeps =
+ PackageDeps (Map.Map (String, UnitId, DPackageId) (Set.Set ModuleName))
+ deriving newtype (Monoid)
+
+newtype DPackageId = DPackageId PackageId
+ deriving newtype (Eq)
+
+instance Ord DPackageId where
+ DPackageId (PackageId d1) `compare` DPackageId (PackageId d2) = d1 `lexicalCompareFS` d2
+
+instance Semigroup PackageDeps where
+ PackageDeps l <> PackageDeps r = PackageDeps (Map.unionWith (Semigroup.<>) l r)
+
+data Deps =
+ Deps {
+ sources :: Set.Set FilePath,
+ modules :: (Set.Set ModuleName, Set.Set ModuleName),
+ packages :: PackageDeps,
+ cpp :: Set.Set FilePath,
+ options :: [String],
+ preprocessor :: Maybe FilePath
+ }
+ deriving stock (Generic)
+ deriving (Semigroup, Monoid) via (Generically Deps)
+
+newtype DepJson = DepJson (Map.Map ModuleName Deps)
+
+instance ToJson DepJson where
+ json (DepJson m) =
+ JSObject [
+ (moduleNameString target, JSObject [
+ ("sources", array sources normalise),
+ ("modules", array (fst modules) moduleNameString),
+ ("modules-boot", array (snd modules) moduleNameString),
+ ("packages",
+ JSArray
+ [ package name unit_id package_id mods
+ | ((name, unit_id, dpkd_id), mods) <- Map.toList packages
+ , let DPackageId package_id = dpkd_id
+ ]
+ ),
+ ("cpp", array cpp id),
+ ("options", JSArray $ map JSString options),
+ ("preprocessor", maybe JSNull JSString preprocessor)
+ ])
+ | (target, Deps {packages = PackageDeps packages, ..}) <- Map.toList m
+ ]
+ where
+ package name unit_id (PackageId package_id) mods =
+ JSObject [
+ ("id", JSString (unitIdString unit_id)),
+ ("name", JSString name),
+ ("package-id", JSString (unpackFS package_id)),
+ ("modules", array mods moduleNameString)
+ ]
+
+ array values render = JSArray (fmap (JSString . render) (Set.toList values))
+
+initDepJson :: IO (IORef DepJson)
+initDepJson = newIORef $ DepJson Map.empty
+
+insertDepJson :: [ModuleName] -> Deps -> DepJson -> DepJson
+insertDepJson targets dep (DepJson m0) =
+ DepJson
+ $ foldl'
+ ( \acc target ->
+ Map.insertWith
+ (Semigroup.<>)
+ target
+ dep
+ acc
+ )
+ m0
+ targets
+
+updateDepJson :: Bool -> DepNode -> [Dep] -> DepJson -> DepJson
+updateDepJson include_pkgs DepNode {..} deps =
+ insertDepJson [moduleName dn_mod] payload
+ where
+ payload = node_data Semigroup.<> foldMap dep deps
+
+ node_data =
+ mempty {
+ sources = Set.singleton dn_src,
+ preprocessor = pi_processor dn_preprocessor,
+ options = pi_options dn_preprocessor
+ }
+
+ dep = \case
+ DepHi {dep_mod_name, dep_local, dep_unit, dep_boot}
+ | dep_local
+ , let set = Set.singleton dep_mod_name
+ value | IsBoot <- dep_boot = (Set.empty, set)
+ | otherwise = (set, Set.empty)
+ -> mempty {modules = value}
+
+ | include_pkgs
+ , Just unit <- dep_unit
+ , let PackageName nameFS = unitPackageName unit
+ name = unpackFS nameFS
+ withLibName (PackageName c) = name ++ ":" ++ unpackFS c
+ lname = maybe name withLibName (unitComponentName unit)
+ key = (lname, unitId unit, DPackageId $ unitPackageId unit)
+ -> mempty {packages = PackageDeps (Map.singleton key (Set.singleton dep_mod_name))}
+
+ | otherwise
+ -> mempty
+
+ DepCpp {dep_path} ->
+ mempty {cpp = Set.singleton dep_path}
+
-----------------------------------------------------------------
-- Module cycles
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -760,6 +760,9 @@ addOptCmmP f = alterToolSettings $ \s -> s
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = f }
+setDepJson :: FilePath -> DynFlags -> DynFlags
+setDepJson f d = d { depJson = Just f }
+
setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
@@ -1245,6 +1248,7 @@ dynamic_flags_deps = [
-------- ghc -M -----------------------------------------------------
, make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix)
, make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile)
+ , make_ord_flag defGhcFlag "dep-json" (hasArg setDepJson)
, make_ord_flag defGhcFlag "include-cpp-deps"
(noArg (setDepIncludeCppDeps True))
, make_ord_flag defGhcFlag "include-pkg-deps"
=====================================
testsuite/tests/driver/T24384/A.hs
=====================================
@@ -0,0 +1,5 @@
+{-# language Strict #-}
+{-# options_ghc -fexpose-all-unfoldings #-}
+module A where
+
+import {-# source #-} C
=====================================
testsuite/tests/driver/T24384/C.hs
=====================================
@@ -0,0 +1,6 @@
+module C where
+
+import A
+import Data.Set
+
+data C = C
=====================================
testsuite/tests/driver/T24384/C.hs-boot
=====================================
@@ -0,0 +1,5 @@
+module C where
+
+import E
+
+data C
=====================================
testsuite/tests/driver/T24384/D.hs
=====================================
@@ -0,0 +1,4 @@
+module D where
+
+import B
+import C
=====================================
testsuite/tests/driver/T24384/E.hs
=====================================
@@ -0,0 +1,14 @@
+module E where
+
+import Language.Haskell.TH.Syntax
+import Dep
+import DepPublic
+
+e :: Q Exp
+e = lift (5 :: Integer)
+
+edep :: ()
+edep = dep
+
+edepPub :: ()
+edepPub = depPub
=====================================
testsuite/tests/driver/T24384/Makefile
=====================================
@@ -0,0 +1,38 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+
+PKGCONF_LOCAL=./db.package.conf
+GHC_PKG_LOCAL='$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_LOCAL)
+
+T24384:
+ $(GHC_PKG_LOCAL) init $(PKGCONF_LOCAL) 2>&1 >/dev/null
+
+ cd dep-internal && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-internal-1-XXX \
+ -package base \
+ -i. DepInternal
+ $(GHC_PKG_LOCAL) register --force dep-internal/dep-internal.pkg 2>&1 >/dev/null
+
+ cd dep-public && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-public-1-XXX \
+ -package base \
+ -i. DepPublic
+ $(GHC_PKG_LOCAL) register --force dep-public/dep-public.pkg 2>&1 >/dev/null
+
+ cd dep && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir outdir -this-unit-id dep-1-XXX \
+ -package-db ../$(PKGCONF_LOCAL) -package-id dep-internal-1-XXX \
+ -i. Dep
+ $(GHC_PKG_LOCAL) register --force dep/dep.pkg 2>&1 >/dev/null
+
+ '$(TEST_HC)' -M -dep-json dep.json -include-pkg-deps -include-cpp-deps \
+ -hide-all-packages -package base -package containers -package template-haskell \
+ -package-db ./$(PKGCONF_LOCAL) -package-id dep-1-XXX -package-id dep-public-1-XXX \
+ A.hs lib/B.hs C.hs D.hs E.hs
+
+ cat dep.json | jq --sort-keys
=====================================
testsuite/tests/driver/T24384/T24384.stdout
=====================================
@@ -0,0 +1,157 @@
+{
+ "A": {
+ "cpp": [],
+ "modules": [],
+ "modules-boot": [
+ "C"
+ ],
+ "options": [
+ "-XStrict",
+ "-fexpose-all-unfoldings"
+ ],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "A.hs"
+ ]
+ },
+ "B": {
+ "cpp": [],
+ "modules": [
+ "A"
+ ],
+ "modules-boot": [],
+ "options": [
+ "-F",
+ "-pgmF",
+ "./preproc.sh"
+ ],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": "./preproc.sh",
+ "sources": [
+ "lib/B.hs"
+ ]
+ },
+ "C": {
+ "cpp": [],
+ "modules": [
+ "A",
+ "E"
+ ],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ },
+ {
+ "id": "containers-0.8-inplace",
+ "modules": [
+ "Data.Set"
+ ],
+ "name": "containers",
+ "package-id": "containers-0.8"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "C.hs",
+ "C.hs-boot"
+ ]
+ },
+ "D": {
+ "cpp": [],
+ "modules": [
+ "B",
+ "C"
+ ],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "D.hs"
+ ]
+ },
+ "E": {
+ "cpp": [],
+ "modules": [],
+ "modules-boot": [],
+ "options": [],
+ "packages": [
+ {
+ "id": "base-4.23.0.0-inplace",
+ "modules": [
+ "GHC.Essentials",
+ "Prelude"
+ ],
+ "name": "base",
+ "package-id": "base-4.23.0.0"
+ },
+ {
+ "id": "dep-1-XXX",
+ "modules": [
+ "Dep"
+ ],
+ "name": "dep",
+ "package-id": "dep-1"
+ },
+ {
+ "id": "dep-public-1-XXX",
+ "modules": [
+ "DepPublic"
+ ],
+ "name": "dep-public",
+ "package-id": "dep-public-1"
+ },
+ {
+ "id": "template-haskell-2.25.0.0-inplace",
+ "modules": [
+ "Language.Haskell.TH.Syntax"
+ ],
+ "name": "template-haskell",
+ "package-id": "template-haskell-2.25.0.0"
+ }
+ ],
+ "preprocessor": null,
+ "sources": [
+ "E.hs"
+ ]
+ }
+}
=====================================
testsuite/tests/driver/T24384/all.T
=====================================
@@ -0,0 +1,7 @@
+test('T24384',
+ [ extra_files(['A.hs', 'lib/', 'C.hs', 'C.hs-boot', 'D.hs', 'E.hs',
+ 'dep', 'dep-internal', 'dep-public',
+ 'preproc.sh'
+ ])
+ ],
+ makefile_test, [])
=====================================
testsuite/tests/driver/T24384/dep-internal/DepInternal.hs
=====================================
@@ -0,0 +1,3 @@
+module DepInternal where
+depInt :: ()
+depInt = ()
=====================================
testsuite/tests/driver/T24384/dep-internal/dep-internal.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep-internal
+version: 1
+id: dep-internal-1-XXX
+key: dep-internal-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: DepInternal
+depends:
+import-dirs: ${pkgroot}/dep-internal/outdir
+library-dirs: ${pkgroot}/dep-internal/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/dep-public/DepPublic.hs
=====================================
@@ -0,0 +1,3 @@
+module DepPublic where
+depPub :: ()
+depPub = ()
=====================================
testsuite/tests/driver/T24384/dep-public/dep-public.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep-public
+version: 1
+id: dep-public-1-XXX
+key: dep-public-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: DepPublic
+depends:
+import-dirs: ${pkgroot}/dep-public/outdir
+library-dirs: ${pkgroot}/dep-public/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/dep/Dep.hs
=====================================
@@ -0,0 +1,4 @@
+module Dep where
+import DepInternal
+dep :: ()
+dep = depInt
=====================================
testsuite/tests/driver/T24384/dep/dep.pkg
=====================================
@@ -0,0 +1,11 @@
+name: dep
+version: 1
+id: dep-1-XXX
+key: dep-1-XXX
+visibility: public
+abi: inplace
+exposed-modules: Dep
+depends: dep-internal-1-XXX
+import-dirs: ${pkgroot}/dep/outdir
+library-dirs: ${pkgroot}/dep/outdir
+include-dirs:
=====================================
testsuite/tests/driver/T24384/lib/B.hs
=====================================
@@ -0,0 +1,2 @@
+{-# options_ghc -F -pgmF ./preproc.sh #-}
+module B where
=====================================
testsuite/tests/driver/T24384/preproc.sh
=====================================
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+
+sed '/preproc/d' $2 > $3
+echo 'import A' >> $3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9c357394147d81fd6ec9c4d70cf4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9c357394147d81fd6ec9c4d70cf4…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
22 Sep '26
Hannes Siebenhandl pushed new branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/dep-json
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/int-index/T7803] 110 commits: loopImports: Don't dup ms_uid in summary imports
by Vladislav Zavialov (＠int-index) 22 Sep '26
by Vladislav Zavialov (＠int-index) 22 Sep '26
22 Sep '26
Vladislav Zavialov pushed to branch wip/int-index/T7803 at Glasgow Haskell Compiler / GHC
Commits:
c130188d by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00
loopImports: Don't dup ms_uid in summary imports
We were writing the ms_unitid of the mod summary with every single
import of that module
That complicated the code (as though the UnitId in that list could ever
be something else) and also allocates unnecessarily per every mod
import. Very slight allocation decrease measured locally in a few tests:
(MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%)
Purely a clean up.
- - - - -
c71166a8 by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (notably, NEVER summarise the
same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
Perf changes:
MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
ebc4047b by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00
implicitRequirementsShallow can never reach HoleUnit
findImportedModule will never return `HoleUnit` for a `ModuleName`
(a `HoleUnit` can only be found as a signature instantiation, never as a
directly *imported* thing)
Therefore, we can drop `[ModuleName]` returned by
`implicitRequirementsShallow`, which makes many things dead code.
Namely, the call to `implicitRequirementsShallow` from
GHC.Driver.Downsweep which was a performance bottleneck (for doing lots
of duplicate work in findImportedModule) is now entirely gone.
Fixes #27053
In an MR with this patch and the downsweep refactor (previous commit), CI says:
MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
85a6ab01 by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00
downsweep: Cache negative results
When traversing a module graph structure, a uniquely identified node
should always expand to the same thing.
I don't see how visiting the same node which failed to be expanded a
first time would ever successfully expand the second time we try to
expand it (eg. when coming from a different edge to it -- it is still
the same node!). The node expansion is local, based just based on the
node itself, not on the path to get there.
Therefore, this patch removes the weird behavior and commentary of
`dfsBuild` wrt to `Nothing` not being cached and being potentially
expanded a second time around to something different, which was
misleading and, ultimately, incorrect.
Now, we have a `MGRes`, which is more explicit about a node being
Skipped just being a node that is ignored whenever it is found (and that
skip is cached) -- and we may want to do this due to failures or due to
just trying nodes which might not work on purpose, like hs-boots.
We uniformly cache positive and negative results and remove the
assumption that there might be an ordering in which the same node
visited at a later time might be expanded differently.
This makes it possible to traverse the module nodes in parallel without
a change in behavior, since there's no longer a hidden ordering
requirement.
- - - - -
56747c3f by Rodrigo Mesquita at 2026-08-15T06:29:53-04:00
Organize and clean-up GHC.Driver.Downsweep
Simply some cosmetic changes, moving definitions around to structure the
module better into its relevant sections
(In go (ns ++ ss), it's not a problem to use ++ because it's a good
producer and we won't have to append fully before processing the next
item in go)
- - - - -
12f64118 by Wolfgang Jeltsch at 2026-08-15T06:31:12-04:00
Add support for textual output of bytecode file content
- - - - -
a737df91 by Brandon Chinn at 2026-08-15T12:40:25-04:00
Add law in qualified strings doc
- - - - -
e3188581 by Zubin Duggal at 2026-08-15T12:41:06-04:00
DmdAnal: Fix maxDmdType
We need to eta expand the smaller DmdType using defaultArgDmd, like in lubDmdType.
Introduce zipDmdType as a common combinator to implement both maxDmdType and lubDmdType
uniformly.
fixes #27626
- - - - -
ca9b0b22 by mangoiv at 2026-08-15T12:41:47-04:00
hadrian: set the executable bit for hie-bios.bat
- - - - -
1aac7095 by sheaf at 2026-08-16T04:37:16-04:00
Avoid wasteful allocations in mkTyConAppCo
The idiom "traverse isReflCo_maybe" followed by "map fst" used in
'GHC.Core.Coercion.mkTyConAppCo' was allocating a lot of waste.
This commit uses 'GHC.Data.Unboxed.traverseMaybeUB' to avoid all these
unnecessary intermediate allocations.
In a quick microbenchmark for 'mkTyConAppCo', this change resulted in:
- refl case (all argument coercions are reflexive):
- -60% runtime
- -80% allocations
- non-refl case:
- from 0% to -12% runtime (depending on which argument is non-refl)
- from 0% to -70% allocations ( -- '' -- )
Fixes #27648
-------------------------
Metric Decrease:
FamAppCachePerf
SimplCastPerf
T12425
T15703
T26426
T3064
T9872a
T9872b
T9872b_defer
T9872c
T9872d
T5321Fun
T9020
T9630
TcPlugin_RewritePerf
Metric Increase:
LinkableUsage02
-------------------------
- - - - -
3915e982 by Alan Zimmerman at 2026-08-16T04:37:58-04:00
EPA: Remove al_trailing from AnnList
It was not being used
- - - - -
fed942ac by Andreas Klebinger at 2026-08-17T12:11:57-04:00
testsuite: Use sigkill in process009.
SIGHUB might have been blocked by a (grand)*parent of the test.
In such cases the test would fail as the python process would simply
exist gracefully instead of committing to a premature end.
By using SIGKILL we can rely on the signal not being blocked, fixing #27578
in the process.
- - - - -
574c875f by Andreas Klebinger at 2026-08-17T12:12:39-04:00
Simplify comparison in DFM.hs
Fixes #27669
- - - - -
d8f1a2a3 by Alan Zimmerman at 2026-08-17T12:13:18-04:00
TTG: Add extension points to BooleanFormula
They are currently unused, but will be used for exact print
annotations next, allowing us to get rid of LocatedBF / SrcSpanAnnBF
- - - - -
93a2b20f by Andreas Klebinger at 2026-08-18T04:31:04-04:00
Fix a number of incorrect module references:
Fix module reference in Note [DataCon wrappers are conlike].
Fix module reference in Note [Detailed InertCans Invariants].
Fix module reference in Note [GHC's data format representations].
Fix module reference in Note [Grand plan for static forms].
Fix module reference in Note [How tuples work].
Fix module reference in Note [Solved dictionaries].
Fix module reference in Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)].
Fix module reference in Note [The VarBndr type and its uses].
Found the incorrect references with a llm.
- - - - -
eb0dfb01 by Simon Jakobi at 2026-08-18T04:31:44-04:00
ci: Run stack-hadrian-build only in full-ci pipelines
The job exists to catch changes that break hadrian/build-stack (#18726),
but nothing in the pipeline depends on it, and it can only break when
hadrian's dependencies change. Restricting it to full-ci (like
hadrian-multi) still covers marge-bot merge batches, so such breakage
cannot reach master unnoticed, while ordinary validate pipelines skip
the job.
Assisted-by: Claude Fable 5
- - - - -
b9160962 by Simon Jakobi at 2026-08-20T14:57:52-04:00
testsuite: Show baseline sample count and range in perf failures
A perf baseline is the mean of all samples recorded for a commit, and
it prints as a single number, hiding how far the samples spread. When
the spread is wide, this can indicate an unstable metric that isn't
actually useful as a signal for the perf tests.
For example, in #27602, T27336's peak_megabytes_allocated baseline
showed as 757 when the underlying samples were 605 and 909.
When the baseline is averaged from more than one sample, say so in the
failure output: the one-line stat-failure reason shows the sample
range, and the detail block lists the raw samples. Single-sample
baselines print exactly as before.
Context: #27602
Assisted-by: Claude Fable 5
- - - - -
a4979877 by Simon Jakobi at 2026-08-20T14:57:52-04:00
testsuite: Fold Baseline into CommitMetric
A Baseline was just a CommitMetric plus the commit it came from, built
by copying fields across. Since get_commit_metric already knows that
commit, record it on CommitMetric itself and drop Baseline. This also
collapses both branches of find_baseline into plain returns.
Assisted-by: Claude Fable 5
- - - - -
99fb8d68 by Simon Jakobi at 2026-08-20T14:57:52-04:00
ci: Clarify comment on pushing perf notes after failures
Context: #27602
Assisted-by: Claude Fable 5
- - - - -
2ca87972 by Alan Zimmerman at 2026-08-20T14:58:36-04:00
EPA: Remove LocatedBC / SrcSpanBF
The custom annotations are now in the BooleanFormula TTG extension
points, so LBooleanFormula can now use the standard LocatedA.
- - - - -
d2bc32aa by Simon Peyton Jones at 2026-08-21T12:59:26-04:00
Better handling of serialisation of wired-in names
Fixes #27501
- - - - -
d2795ffc by Alan Zimmerman at 2026-08-21T13:00:05-04:00
EPA: Remove NoEpTok/NoEpUniTok, using an unhelpful SrcSpan instead
Also introduce helper functions noEpTok and noEpUniTok to serve
as simple replacements in code inserting an token annotation without
location information.
- - - - -
b5d29ab8 by Brandon Chinn at 2026-08-25T18:42:08-04:00
Add Data.RealFloat and Infinity/NegInfinity/NaN pattern synonyms (#26961)
- - - - -
e60eb3bc by Andreas Klebinger at 2026-08-25T18:42:59-04:00
rts linker: Fix pointer arithmetic issue in flushInstructionCacheRISCV64
We accidentally operated over `uint64_t*` when we should use `uint8_t`.
Fixes #27569
- - - - -
e9bbe8f9 by Andreas Klebinger at 2026-08-26T15:09:23-04:00
cmm dumps: Add machop width info with -dppr-debug for infix ops.
- - - - -
86e3a9d8 by Andreas Klebinger at 2026-08-26T15:09:24-04:00
CmmLint: Check for unsupported MachOp widths
machOpArgReps now maps MachOp + Width to a list of supported
argument widths or Nothing if the given operation is not supported
at the given width.
This allows us to check for nonsensical combinations like FloatToInt
at Word16.
Similarly we now check that every address is actually wordwidth.
- - - - -
13781cca by Andreas Klebinger at 2026-08-26T15:09:24-04:00
arm64 ncg: The big subword truncation fix.
A set of slightly related fixes to arm subword handling:
Bitmask immediates:
Don't produce overflowing assembly literals.
There is still another bug here that causes us to miss some valid
literals but we will fix that later.
Improve subword truncation handling:
We now use a small set of helpers to truncate `Register` values rather
than truncating immediate `Reg` values which greatly simplifies the code
structure. This fixes a great many bugs to do with sign/zero extending subwords
or the lack thereof.
We now establish the invariant that subword values are zero-extended at
every site at which they come into "scope" of the ncg, and rely on the
invariant throughout rather than pessimistically inserting redundant
extensions in a hodgepodge manner at the use sites of these values.
This fixes at least the bugs described in issues #27533, #27430
#27537, #27538, #27539, and #27550. But likely more bugs yet not
found.
Subword ffi results:
Apply truncations when calling functions returning
subword values.
genCondJump:
Don't sign extend signed values in the input register as
it might map to a local variable, corrupting the value stored within.
Fix subword store/load instructions.:
We used to read those at 32bit width even for smaller values possibly
resulting in invalid memory access. Now we construct the suffix for
subword variants based on the instruction format for these.
- - - - -
d8fa5d7c by Andreas Klebinger at 2026-08-26T15:09:24-04:00
arm64 ncg: Fix MO_V_Broadcast for non-literals.
We now use OpReg instead of OpScalarAsVec as required since we broadcast a gp register.
Also adds a test. Fixes #27565.
- - - - -
94822c95 by Andreas Klebinger at 2026-08-26T15:09:24-04:00
Add some test cases covering bugs in the arm ncg.
* Test for #27430 (subword ffi results)
* #27537 - subword conversions
* #27538 - subwords used in conditional
* #27533 - single byte read
- - - - -
dd1ba88a by Andreas Klebinger at 2026-08-26T15:09:24-04:00
cmmLint: Lint against MO_FS_Truncate subword use.
- - - - -
fd22f71e by Zubin Duggal at 2026-08-26T15:10:20-04:00
ghc-internal: annotateSTM should use catchSTM# rather than catch#
A catch# frame inside a transaction breaks retry and async exception
delivery.
Fixes #27657
- - - - -
bb324171 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00
rts: refactor to reduce THREADED_RTS in MSG_UPD_TSO_FLAGS
- No behavior change in this commit (well, a small optimization here
makes us do less work if the target TSO owned by the curr. capability)
- Move all THREADED_RTS CPP needed into `updThreadFlag`
- Merge MSG_SET_TSO_FLAGS and MSG_UNSET_TSO_FLAGS into MSG_UPD_TSO_FLAGS
plus a `set` bool field in the MessageUpdTSOFlag struct
Towards #27729
- - - - -
ed99b7b7 by Rodrigo Mesquita at 2026-08-26T15:10:59-04:00
rts: Fix race condition in MSG_UPD_TSO_FLAGS execution
The code for processing the MSG_UPD_TSO_FLAGS message was not taking
into consideration that the TSO's owner might have moved in between that
capability receiving the message (since it was its previous owner) and
starting to process its inbox (a point at which it was no longer the
owner)
Added Note [TSO owner may change in between Msg being sent and received]
to explain this race and the pattern used to fix this, where we just
forward the message to the new owner.
Fixes #27729
- - - - -
cd653714 by Alan Zimmerman at 2026-08-26T15:11:49-04:00
EPA: Uses Parsers.parseModule for exactprint tests
Parsers.parseModule is the advertised way to parse for use for exact
printing in the ghc-exactprint library. This commit updates the GHC
exact print testing to use it.
This requires moving the comment balancing that was occurring
only in the test path into the advertising parser path, so it moves
from Transforms.hs to Utils.hs.
Also update the comment adding to honour trailing annotations
- - - - -
d1d01fa5 by Wolfgang Jeltsch at 2026-08-27T13:17:59+03:00
Add `rethrowSTM` and improve STM-related documentation
Adding `rethrowSTM` resolves #26758.
The implementation of `rethrowSTM` is completely analogous to the one of
`rethrowIO`.
The following is established for the documentation of `throwSTM` and
`catchSTM`:
* Both operations are directly described as analogs of their `IO`
counterparts.
* There is no reference to `throw` in the documentation of `throwSTM`,
because, although such a reference is great in the documentation of
`throwIO`, it is somewhat out of place in the documentation of
`throwSTM`.
* Instead of repeating part of `throwIO`’s documentation, the
documentation of `throwSTM` just recommends using `throwSTM` instead
of `throw` and references the corresponding arguments in the
documentation of `throwIO`.
- - - - -
06fde293 by fendor at 2026-08-28T06:06:44-04:00
GHCi: Fix order of `PackageDBFlag`s for interactive home unit
`PackageDBFlag`s are stored in reverse order of cli specification.
When sorting the `PackageDBFlag`s by longest common prefix, we need thus
to reverse the package db stacks before calculating the prefix.
We make sure to reverse the package db stack for the interactive home
unit to uphold that later specified package dbs overwrite earlier ones.
Resolved and adds regression test for #27640
- - - - -
024c4d04 by fendor at 2026-08-28T06:07:23-04:00
Reuse the UnitIndexCache after initialising multiple home units
- - - - -
55326fa0 by Alan Zimmerman at 2026-08-28T06:08:03-04:00
EPA: Some Haddock processing tweaks
These changes to the Haddock postprocessing should not change
behaviour, but just bring it more closely in line with the
original, changed at 44309cd377f
And add some haddock exactprint tests to show they work.
- - - - -
b3ddee95 by Andreas Klebinger at 2026-08-28T13:57:46-04:00
hadrian: Deprecate quickest flavour.
It was more of a trap for new users than actually beneficial so we
deprecate it and suggest quick+no_dynamic_libs to users instead.
- - - - -
a1d81390 by Andreas Klebinger at 2026-08-28T13:58:37-04:00
cmm: Always favour entry block during block deduplication.
We now always keep the first block in the CmmGraph. This way we avoid
the need to update the entry info table.
Failing to do so caused #27722.
Fixes #27722.
- - - - -
5bd65f00 by Andreas Klebinger at 2026-08-28T13:59:16-04:00
test: FamAppCachePerf - Only collect bytes allocated. Fixes 27747
- - - - -
ced53ce6 by mangoiv at 2026-08-29T07:15:24-04:00
nightlies: output yaml to file only
Previously we would just output the metadata to stdout
which risks that it's clobbered by incidental debugt output.
We now output to file only.
Fixes #27511
- - - - -
578bd185 by Andreas Klebinger at 2026-08-29T07:16:05-04:00
Specialise: Stop looping on recursive dictionaries in interestingDict
interestingDict now doesn't look through loopbreaker unfoldings.
Doing so would cause infinite loops on certain dictionaries.
Fixes #27705.
- - - - -
7bf546fc by Simon Peyton Jones at 2026-08-31T23:48:53-04:00
Never make an absent filler for a constraint type
mkAbsentFiller used isTerminatingType to decide, but that is not enough.
Consider
class Eq a => UC a where {}
let u :: UC Int -- UC Int is a "non-terminating type"
u = error "Absent"
let e :: Eq Int -- Eq Int is a "terminating type"
e = $p1UC u
We clearly must not make a filler for `e`, because we speculatively
evaluate it. But speculatively evaluating `e` forces `u`, so we must not
make one for `u` either.
Asking isDictTy instead is not enough either, because it does not catch a
constraint hidden behind an unreduced type family application:
type family F a :: Constraint
type instance F W = TC W
a :: F W => Int -> Int -- (F W) argument is absent
Oops! Entered absent arg Arg: irred
Type: F W
So play safe and use isPredTy: never make an absent filler for any
constraint-kinded type.
Fixes #27627
- - - - -
5f474953 by Zubin Duggal at 2026-08-31T23:48:53-04:00
Add tests for absent fillers at dictionary types
T27627 a unary class whose superclass is a non-unary class
T27627a ...whose superclass is a Constraint-kinded type family
T27627b ...whose superclass is a quantified constraint
T27627c a unary class applied to itself, (UC (UC (TC a)))
T27627e a (forall b. P b) dictionary that loops
- - - - -
cd5c6bcc by Zubin Duggal at 2026-08-31T23:48:53-04:00
An abstract TyCon may hide a unary class
A class declared in an hs-boot file is an AbstractTyCon inside the
module loop, and compiling the real declaration may reveal it to be a
UnaryClassTyCon.
- isTerminatingType returned True for such AbstractTyCons
- IfaceToCore set the unary flag to False in the DFunId
So we could end up speculating bottom dictionaries because inside a module
loop we see an UnaryClassTyCon as an AbstractTyCon
Use isTerminatingTyCon, which returns False for an abstract TyCon.
The Bool in DFunId is now a cache for isTerminatingTyCon, set in
mkDFunIdDetails.
Fixes #27704
- - - - -
abfc224a by Zubin Duggal at 2026-08-31T23:48:53-04:00
Specialise: don't replace dead args with absent fillers
specHeader decides an argument is dead by calling isDeadBinder on a binder of
the /optimised RHS/, then applies the filler to the /stable unfolding/
template instead. The two may differ, so the argument can be dead in
the RHS and not in the template.
The specialised function's unfolding then has an absent filler, and any call
site that inlines it evaluates the error thunk.
Dropping dead args in the specialiser is rarely worth it, to quote Simon,
"The later worker/wrapper pass will pick up the dead arg later if it is really dead. Keeps the specialiser simpler."
So instead of trying to check if the arg really is dead in the stable unfolding,
just drop the logic for dropping dead args in the specialiser altogeher.
Fixes #27703
- - - - -
1557fd1c by Zubin Duggal at 2026-08-31T23:48:53-04:00
CorePrep: don't speculate a call across an hs-boot edge
We take care not to evaluate things that might be bottom, like a
looping dictionary group, but our analysis is defeated by boot files.
We only track recursion within a module, so two dictionaries that
depend on each other across a module loop each look non-recursive, and
we might speculate them.
Any recursion we cannot see must cross an hs-boot edge, so refuse to
speculate calls that cross one.
Fixes #27717
- - - - -
4117e5ae by Wolfgang Jeltsch at 2026-08-31T23:49:35-04:00
Incorporate the `rethrowSTM` reexport into the `stm` submodule
- - - - -
4bfbf5c8 by ARATA Mizuki at 2026-09-01T18:55:08-04:00
testsuite: Fix out-of-bounds access in T3586
unsafeRead and unsafeWrite use 0-based index.
Looking at #3586, the expected output seems to be 2.8e8.
Addresses #27596
- - - - -
3f9db6d4 by ARATA Mizuki at 2026-09-01T18:55:08-04:00
testsuite: Fix out-of-bounds access in T21305
writeInt64Array# takes an index measured in units of Int64 elements.
Fixes #27596
- - - - -
44d7788f by Simon Peyton Jones at 2026-09-01T18:55:53-04:00
Fix buglet in INLINE-arity calculation for pattern synonyms
This fixes #27744.
The buglet was accidentally introduced by
commit 3a0f9a51c1dacc474c7fd128082edd8bf4081256
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Sat Aug 1 00:13:02 2026 +0100
Fix three bugs related to required type args and INLINE pragmas
I failed to find all the calls to `addInlinePragArity`!
- - - - -
df058f1d by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Migrate perf tests off collect_compiler_stats('all')
The 'all' metric argument applies a single tolerance to bytes
allocated, max_bytes_used and peak_megabytes_allocated, although their
noise profiles are incompatible (#27653): allocations are nearly
deterministic, residency needs 10-20%, and peak is quantized to 1 MB.
Any single tolerance is too tight for one metric or too slack for
another. This migrates the remaining users of 'all' (and of the 'all'
default) to explicit per-metric collection, ahead of removing 'all'
from the driver.
peak_megabytes_allocated is dropped everywhere: its 1 MB granularity
makes tight relative windows meaningless (#27613), and it is sensitive
to GC timing. In #27489 it drifted by -5.3% while max_bytes_used moved
by less than 0.1%. Where a test guards a memory property,
max_bytes_used covers it at byte granularity.
Where the motivating ticket was about compile-time memory
(T11545, T15304, T26425), residency remains gated via max_bytes_used,
now with a residency-appropriate tolerance.
max_bytes_used is dropped where residency was only ever an accident of
'all':
* T15630, T15630a, T20261: the underlying tickets (#15630, #20261)
contain no memory data at all. One is a simplifier-ticks blowup and
the other is stated entirely in allocation numbers, so the 20%
window never had teeth.
* T21839c: #21839's measurements show residency essentially flat
(+0.16%) while allocations moved +7%, so allocations are the
discriminating metric. They are already gated at 1% via
collect_compiler_runtime. The ghc/max gate had previously broken CI
spuriously (9fd11585eb widened it from 1% to 10% for that reason).
Allocation tolerances are tightened to the testsuite's conventional 2%
where 'all' previously left them at 10-20%.
Assisted-by: Claude Fable 5
- - - - -
72dd2432 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Remove the 'all' metric argument of collect_stats
'all' gated bytes allocated, max_bytes_used and peak_megabytes_allocated
at a single tolerance, although their noise profiles are incompatible,
making such tests either flaky or toothless (#27653).
Closes #27653.
Assisted-by: Claude Fable 5
- - - - -
2228cb30 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Make the deviation argument of collect_stats mandatory
Almost every caller passes an explicit tolerance matched to the
metric's noise profile, and the silent 20% default is far slacker than
'bytes allocated' merits. Only two tests relied on it. They now state
their tolerance explicitly:
large-project gets 10%, in line with other large compile-time tests.
T9848 gets 2%: its metric is byte-for-byte deterministic across CI
jobs and platforms of a given test_env, has drifted only about 2.5%
since 2015, and the fusion failure it guards against would show up as
a roughly +30000% jump.
Assisted-by: Claude Fable 5
- - - - -
56291fc5 by Cheng Shao at 2026-09-02T07:18:45-04:00
autoconf/ghc-toolchain: bump llvm upper bound to support llvm 23
This commit bumps llvm upper bound to support llvm 23.
- - - - -
20eb3f41 by Cheng Shao at 2026-09-02T07:18:45-04:00
rts: fix compilation issues with clang 23
clang 23 has broadened `-Wall`/`-Wextra` ranges, exposing some minor
issues in the rts when building with validate flavours:
- Unused locals
- `#pragma GCC diagnostic pop` mismatch
This commit fixes those.
- - - - -
9e7739ab by Simon Jakobi at 2026-09-03T13:45:43-04:00
Add -Wimplicit-field-strictness (#16836)
This opt-in warning fires when a data constructor field lacks an
explicit strictness annotation (`!` or `~`). It complements the
LazyFieldAnnotations extension (4762a8bf30f) from GHC proposal 752,
which makes `~` annotations available for this purpose.
Deciding which fields to report requires their levity, so the check
runs after typechecking. To keep the noise down, the diagnostic is
emitted once per data declaration, grouped by constructor.
Closes #16836.
Assisted-by: Claude Fable 5
- - - - -
6a44d591 by mangoiv at 2026-09-03T13:46:22-04:00
simplifier: remove a bogus `assert` in `rebuild_app'` in `GHC.CoreToStg.Prep.cpeApp`.
Prior to this commit
commit 08bc245be70d95801bc1138804ed1de9474fbdc0
Author: sheaf <sam.derbyshire(a)gmail.com>
Date: Sat Feb 28 16:30:43 2026 +0100
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump
any `PlaceRuntime` ticks we observed were profiling ticks, even though that
isn't necessary.
The more liberal rules in the above commit allow e.g. breakpoint ticks
(which are valid PlaceRuntime ticks) to legitimately appear in an argument
position.
Fixes #27556
- - - - -
eaa95a6f by Andrei Borzenkov at 2026-09-04T08:08:40-04:00
Parentheses in prefix GADT constructors (#27423)
Updated `splitLHsGadtTy` to allow looking
through the parentheses for inner binders. General example
of a code pattern that's allowed now:
data S a where
MkS :: (forall a. S a)
That should work now with any combination of nested
foralls and parentheses.
We don't perform parenthesis unwrapping for record
GADT constructors in accordance with GHC Proposal #402.
To this end `con_inner_bndrs` no longer stores plain forall
telescopes: `[HsForAllTelescope pass]` is replaced with
`[LHsGadtTelescope pass]`, a new `HsArg`-style type whose
`HsGadtForAll` holds an inner telescope and whose `HsGadtPar`
holds a pair of parentheses. The parentheses carry no meaning
for renaming or type checking; the only reason to record them
is exact-printing.
Updated `pprConDecl` to improve the `parse == parse . ppr . parse`
property of GADT pretty-printing.
The pretty printer can now output code that's similar to this:
data T a where
MkT1 :: (forall a. T a)
MkT2 :: forall . forall a. T a
These are special cases of inner forall binders
for prefix GADT constructors, when we have either
implicit or zero explicit outer binders.
- - - - -
639456a8 by Evgeny Malyshev at 2026-09-04T08:09:25-04:00
HsPat: Add spacing to unary tuple patterns
Use hsep when printing unary boxed TuplePat applications so that the
MkSolo constructor is separated from its argument. The old hcat rendered
wildcard and parenthesized arguments as MkSolo_ and MkSolo().
Add T27034 to exercise the HsPat splice-dump path with wildcard and
variable arguments, and update existing affected golden output.
Fixes #27034
Assisted-By: OpenAI Codex
- - - - -
2908ab36 by Simon Jakobi at 2026-09-05T07:22:17-04:00
X86 NCG: use btr/bts/btc for single-bit operations
Previously the Cmm patterns
x & ~(1 << i)
x | (1 << i)
x ^ (1 << i)
compiled to mov/shl/not/and-style sequences of 3-4 instructions. Now
they compile to a single btr, bts or btc, matching what C compilers
produce.
When the bit index is a literal, constant folding has already collapsed
these patterns into ones with a literal mask, such as
x & 0xfffffeffffffffff for x & ~(1 << 40). Such masks are now also
compiled to a bit-test instruction when they don't fit in an imm32 and
would otherwise have to be loaded into a register first.
For a variable bit index, this applies only when the shift is unchecked
(uncheckedShiftL#, Data.Bits.unsafeShiftL): the bounds-checked shiftL
used by e.g. the default clearBit/setBit/complementBit implementations
wraps the shift in a bounds mask that this optimisation does not see
through. With a literal index, the bounds mask is constant-folded away,
so the checked operations benefit too.
See Note [Bit-test instructions] in GHC.CmmToAsm.X86.CodeGen.
Fixes #25233.
Assisted-by: Claude Fable 5
- - - - -
c673ecf0 by Simon Peyton Jones at 2026-09-05T07:22:59-04:00
Move HsStatic free-var test to typechecker
A `static` form should have no free *term* variables, but it
can have free *type* variables. Alas, the renamer does not really know what
is a term variable and what is a type variable, because of required type
arguments. This patch moves the test to the typechecker, which does know.
Addresses #27664
- - - - -
5939ceaf by sheaf at 2026-09-05T22:06:18-04:00
Windows: enforce path convention in ./configure
As detailed in Note [MSYS paths] in Hadrian.Utilities, the standing
convention (using Windows-style paths with forward slashes) is now
enforced in ./configure instead of within Hadrian, removing the need for
'cygpath' calls within Hadrian.
Fixes #26683
- - - - -
a6061455 by sheaf at 2026-09-05T22:06:18-04:00
Hadrian: introduce ExeSpawnPath
Specific details about the filepath used to specify the executable to
spawn with CreateProcess matters on Windows: whether we use forward or
backward slashes, a leading ./, or an absolute path changes how the
executable is found.
This commit introduces 'ExeSpawnPath' which is a path that is guaranteed
to be found when spawning a process. All command invocations now go
through this type to ensure the path has been properly sanitised.
See Note [NeedCurrentDirectoryForExePath] in Hadrian.Utilities.
The same treatment is applied to hsc2hs. Updates hsc2hs submodule.
- - - - -
e28313e3 by sheaf at 2026-09-05T22:07:06-04:00
Preserve tick ordering in 'tickTickedExpr'
'GHC.Core.Utils.tickTickedExpr' tries to combine a tick 't1' into an
existing stack of ticks 't2s'. There are two situations:
1. 't1' is subsumed by a tick in 't2s': drop it.
2. A tick in 't2s' is subsumed by 't1', say 't2'.
This commit ensures that in case (2) we keep 't1' on the outside instead
of replacing 't2' at its position in the stack. This avoids re-ordering
source notes (which was the cause of #27749).
This fixes a regression introduced in 2dadf3b0d05.
Fixes #27749
- - - - -
3172f557 by sheaf at 2026-09-05T22:07:06-04:00
Consistently prefer local source note ticks
GHC.Cmm.DebugBlock.cmmDebugGen (DWARF annotations) and
GHC.Stg.Debug.quickSourcePos (-finfo-table-map) both contained logic to
prioritise source note ticks from the current module.
This commit commons up this logic and propagates it to a third consumer:
IPE stack frames, in GHC.Driver.GenerateCgIPEStub.
See the new function GHC.Types.Tickish.bestSourceNote.
- - - - -
192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00
rts: fix ctoi_tuple_spill_words getting out of sync
Fix a few places that were not updating ctoi_tuple_spill_words
correctly, leading to corruption/crashes when dealing with large
unboxed tuples in bytecode:
- captureContinuationAndAbort
- findRetryFrameHelper/findAtomicallyFrameHelper
- interpretBCO bci_BRK_FUN
fixes #27633
- - - - -
604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00
Hadrian: don't capture the testsuite driver's output (#27780)
a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the
cmd' wrapper. cmd' always captures stdout and stderr, and since the
caller asks for Exit, it returns without dumping what it captured. As a
result the testsuite output no longer appears in CI job logs: failures,
performance metrics and the summary were lost with the job.
Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that
commit do.
Fixes #27780.
Assisted-by: Claude Fable 5.1
- - - - -
06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00
rts: Fix missing memory barrier in eval_thunk_selector (#27477)
unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the
indirectee, leading to segfaults and corruption during GC on
weakly-ordered architectures.
Fixes #27477
- - - - -
f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00
EPA Fix HsCmdDo exact print with comments
Exact printing of HsCmdDo was ignoring the location for the do
statements, and this is an annotation that can have comments in it.
Update it so we print the statements as a unit, including any
comments.
Also add the result of auditing that we capture comments in all needed
places, noting that the remaining Anno SrcSpan instances are benign.
- - - - -
430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00
Reorder cmm decls in HeapStackCheck for a better logical grouping
And put more section headers in to deliniate the groups.
We're about to add more here, so better to organise it first.
- - - - -
344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add raisePrimIOException and add it to RTS<->ghc-internal API
The raisePrimIOException is a new helper function that I/O primops will
use to help them report I/O errors. This is implemented in Haskell
(since that's a lot easier), but has a calling convention that is
easy(ish) to use from Cmm in the I/O primops.
So we add it to the RTS API struct, and since we'll use it from Cmm we
also need a field accessor macro for cmm (in deriveConstants).
See the Note about how we cannot have nice things due to async
exceptions and thunks preventing us from using catch.
- - - - -
cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Add new blocking functions for I/O primops
See the Note [Thread blocking for new I/O primops],
and the Note [Calling convention for raisePrimIOException].
The point is, it will allow us to report synchronous exceptions from I/O
primops, and do so much more flexibly.
Previously the I/O managers could only report async exceptions and only
nullary exceptions. This was OK historically, but no good as we add
more I/O managers and expand the range of I/O operations we support.
- - - - -
f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Change the encoding of results from the I/O manager to I/O primops
Previously we just had async continue or heap overflow.
We now extend what we can report with synchronous success, and
synchronous failure with an errno.
See Note [Encoding of result of I/O manager operations]
We don't use these two new cases yet, but we will. In particular an
epoll I/O manager needs to be able to report synchronous success or
failure for waitRead#/waitWrite#.
- - - - -
30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch waitRead/Write# to use new blocking return frames
and update the I/O managers to set the result before resuming the
blocked threads.
This makes it possible for I/O managers to report synchronous exceptions
from the I/O primops, but that will be done in a subsequent commit.
- - - - -
a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00
Switch Poll and Select I/O managers to report sync exceptions
rather than using raiseAsync with blockedOnBadFD_closure.
This uses the new mechanism in the blocking frame return code to report
synchronous exceptions.
- - - - -
7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00
Remove now-unused blockedOnBadFD
It was previously thrown by the select and poll I/O managers, but now
they use raisePrimIOException (with an EBADF errno).
- - - - -
6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00
Improve the docs for delay# waitRead# and waitWrite#
Document that the waitRead/Write# can throw exceptions (this was true
before too), and that all of them are async exception cancellation
points.
- - - - -
afeb2c30 by Duncan Coutts at 2026-09-09T20:08:58-04:00
Enable printf warnings for trace functions and fix resulting warnings
Most of the existing printf-style functions are annotated with
attributes to enable gcc/clang warnings for the printf format string,
but several trace functions in Trace.h were missing this annotation.
Enable them, and fix the resulting warnings.
- - - - -
9a442c93 by Alan Zimmerman at 2026-09-09T20:09:36-04:00
EPA: Exact print ConDeclGADT without custom enterAnn
!16321 brought in explicit capture of parens in a ConDeclGADT.
The ExactPrint update introduced a modification of the fundamental
function in exact printing, `enterAnn`, by splitting it into a version
allowing injection of functionality normally handled by the
ExactPrint class methods.
This commit refactors that code, to restore the prior `enterAnn`
version, by following the convention in ExactPrint of introducing a
helper data structure with its own `ExactPrint` instance to achieve
the same effect.
- - - - -
4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00
ci: Actually pass --ignore-perf-failures to the testsuite driver
684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to
RUNTEST_ARGS with bash array syntax, but the three use sites still
expand RUNTEST_ARGS as a scalar, which yields only the first array
element. The appended flag was therefore dropped in every job, so
perf improvements kept failing Marge Bot batches and master pipelines,
contrary to #19562.
Append as a string instead, matching the existing --force-colors
append in test_hadrian.
Fixes #27563.
Assisted-by: Claude Fable 5.1
- - - - -
4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00
testsuite: Give T26537 a 1.5x compile timeout
Its -fregs-graph compile step tends to time out in unoptimized builds
(#27188, #27776).
Assisted-by: Claude Fable 5.1
- - - - -
130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00
EPA: Remove ListBanana / ListParens from AnnListBrackets
This is a step towards making AnnList only represent
lists of items which can have either braces or layout.
- - - - -
a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00
Reject ~, UNPACK and multiplicity annotations on type data fields
Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations
were silently accepted. None of them make sense at the type level, so
restriction (R3) of Note [Type data declarations] now covers all of
them.
Fixes #27732.
Assisted-by: Claude Fable 5.1
- - - - -
c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00
EPA: Add a Note for the exact print main loop
- - - - -
7a108e43 by Simon Jakobi at 2026-09-12T18:35:59-04:00
FastString: Drop mkFastStringWith's constructor callback
All three callers passed the same callback, a partial application of
mkNewFastStringShortByteString to the string being interned. That
partial application is allocated as a closure before the table lookup,
on the common hit path too, although the callback is needed only after
a miss.
Drop the parameter and call mkNewFastStringShortByteString directly
after a miss. Since nothing is passed "with" anymore, rename the
function to internSB.
Suggested by Simon PJ in #27528:
https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031
Assisted-by: Claude Fable 5
- - - - -
82c73b22 by Alan Zimmerman at 2026-09-12T18:36:38-04:00
EPA: More targeted HsDo exact print annotation
HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of
these are in a layout context (DoExpr, MDoExpr), others are not
(ListComp, MonadComp).
We are moving towards using AnnList only in layout contexts, so we
switch the HsDo TTG annotation from holding an AnnList for this, to
holding
Either (EpToken "[", EpToken "]") AnnList
This also allows us to trim down AnnListBrackets to only have braces
or None, thereby opening the door for unification with the existing
layout context data type EpLayout.
- - - - -
749d2448 by Luite Stegeman at 2026-09-15T14:07:01-04:00
rts: handle large CONSTR closures in compacting GC
The function update_fwd_large in the compacting GC could run into
an unexpected object with the following error:
internal error: update_fwd_large: unknown/strange object 1
Closure type 1 is CONSTR. This patch adds cases for CONSTR and
CONSTR_NOCAF.
This is the same problem as #27434 (large AP closures, fixed by
cca0d58963), which missed this case.
Fixes #27649
- - - - -
177d6155 by Luite Stegeman at 2026-09-15T14:07:02-04:00
testsuite: fix T27434 test with compacting GC
Ensure that the interpreter is actually run with the compacting GC
- - - - -
5796aa63 by Luite Stegeman at 2026-09-15T14:07:49-04:00
rts: initialise the stack frame header for mask_frame and apply_mask_frame
We must leave the stack in consistent state before jumping to
mask_frame or apply_mask_frame because they may result. Failing
to do so could lead to a crash if there were waiting exceptions.
Fixes #27651
- - - - -
2486cc92 by Simon Peyton Jones at 2026-09-15T14:08:36-04:00
Re-introduce the "weird SpecDict" case
In this commit
commit f80375dd4945350a1d784e436975b48b9c736eaf
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Sun Jun 29 15:26:58 2025 +0100
Refactor of Specialise.hs
I removed a test for a dictionary with unbound type variables. This
turned out to be wrong; see #27629.
So this MR re-introduces it.
- - - - -
8e09a46f by Duncan Coutts at 2026-09-15T20:11:35-04:00
Refactor (and rename) removeFromQueues, to simplify I/O managers
Rename it to unblockAndAppendToRunQueue which better reflects what it is
intended to do.
The post-condition for unblockAndAppendToRunQueue is that the TSO is on
the run queue or it is in the process of migrating to another cap.
Previously it achieved that by always directly adding the TSO to the run
queue itself.
But this actually made things more complicated for the I/O managers,
because it meant they needed a separate code path for notifying for
cancellation compared to notifying for completion. The general
notification code would always add the TSO to the run queue itself.
So the improvement is to allow different cases in
unblockAndAppendToRunQueue to achieve the same outcome in different
ways: either directly adding to the run queue or calling helper
functions that do so themselves.
This then allows the new I/O managers to share code between the sync and
async cancellation, and to reuse their notifyIOCompletion helpers for
cancellation. This avoids a source of bugs where the completion path may
be updated but the cancellation path may be forgotten, or similarly in
future for sync/async operations.
Update all the existing in-RTS I/O managers, and the posix timeout code.
- - - - -
d668782c by Duncan Coutts at 2026-09-15T20:11:35-04:00
Document that awaitCompletedTimeoutsOrIO expects an empty run queue
This was true before but implicit and not relied on much. It's better to
be explicit, and allow things to depend on it.
- - - - -
11d938bb by Duncan Coutts at 2026-09-15T20:11:35-04:00
Store the I/O opcode and fd in the StgAsyncIOOp
This will be useful in several I/O managers and it is handy for logging
and debugging.
It also doesn't increase the size of the StgAsyncIOOp structure. There
was enough spare padding space already.
Update the poll I/O manager to set the new fields.
Add a helper function to convert the enum IOReadOrWrite into the enum
IOOpCode. Also change IOReadOrWrite to be an enum without a typedef, for
consistency with other enumerations in IOManager.h
- - - - -
bfa87882 by Duncan Coutts at 2026-09-15T20:11:36-04:00
Add a new I/O manager based on select()
Yes, this is the second such I/O manager, but it is a modern
re-implementation based on the new in-RTS I/O manager infrastructure. So
it is cleaner and faster than the old select I/O manager.
Why do we need another I/O manager based on select? Why isn't the poll()
one good enough as a baseline portable unix I/O manager? Because macOS.
Apple Inc. is why we cannot have nice things.
The man page for poll on macOS documents the fact that it does not work.
At least, it does not work for all files. Specifically, it does not work
for device files. Whereas macOS select() does work for device files.
Aaaaarg!
We _do_ want to deprecate and remove the old select I/O manager, but due to
macOS we cannot do that until we have a replacement. This is that
replacement. Until of course a nice new k-queue I/O manager arrives,
which could become the new default for macOS and FreeBSD.
Interestingly, this select I/O manager is actually faster than the poll
one, on Linix, in some circumstances: specifically when many Haskell
threads are waiting on the same fd. The poll I/O manager does O(n) work
for n threads waiting on I/O, whereas the select one does O(fds) work
for the number of fds that threads are waiting on. Usually this is 1:1,
so it's not noticable, but one can concoct extreme benchmarks to show
the difference.
- - - - -
8e9de15a by Duncan Coutts at 2026-09-15T20:11:36-04:00
Minor updates in the poll I/O manager to keep in sync with select
This keeps it in sync with select one. The changes are based on code review
while implementing the new select I/O manager. The two I/O managers are so
similar in structure that it makes sense to try to minimise the diff between
them. This should aid understanding, and fixes to both in future.
- - - - -
222668bb by Duncan Coutts at 2026-09-15T20:11:36-04:00
Document the new select I/O manager in the user guide
in the RTS section about I/O managers.
And add a changelog entry.
- - - - -
0f48735b by Cheng Shao at 2026-09-15T20:12:23-04:00
Revert "wasm: workaround WebKit bug in dyld"
This reverts commit c9b8465c2c338176fcab9d197e9d31f4aee11f68. The
underlying webkit bug has been fixed in
https://commits.webkit.org/314219@main. Closes #27564.
- - - - -
809294f1 by Luite Stegeman at 2026-09-15T20:13:08-04:00
rts: make stg_threadLabelzh return a valid pointer for unlabeled threads.
This fixes a segfault in the GC caused by stg_threadLabelzh returning
a 0 pointer in a GC pointer field.
stg_threadLabelzh returns a tuple of type (# Int#, ByteArray# #). If a
thread has no label, the second field is unused. We must still return
a valid heap object pointer.
Instead of returning 0, we now return stg_DEAD_SLOT_closure.
fixes #27618
- - - - -
e2d57026 by Luite Stegeman at 2026-09-15T20:13:54-04:00
JS: fix selector thunk handling
fix a bug where entering a selector thunk could lead to a crash
if the selected field was still a thunk.
fixes #27788
- - - - -
1b4a622f by sheaf at 2026-09-17T02:39:13-04:00
Improvements to type/data family handling
This commit makes several improvements to the treatment of type and data
families in GHC:
- We consistently use "type family" instead of "type synonym family"
to avoid a confusion with type synonyms. For example:
- OpenSynFamilyTyCon ==> OpenTypeFamilyTyCon
- ClosedSynFamilyTyCon => ClosedTypeFamilyTyCon
- Various functions that were specific to data families have been
renamed to make this clear. For example:
- tyConFamInst_maybe ==> tyConDataFamInst_maybe
- isFamInstTyCon ==> isDataFamInstTyCon
- 'FamTyConFlav' has been refactored so that all closed type families
share a single 'ClosedTypeFamilyTyCon' constructor.
The corresponding 'IfaceFamTyConFlav' type was updated similarly.
This is then used to tidy up the implementation of
GHC.Core.FamInstEnv.reduceTyFamApp_maybe.
- - - - -
c5aa9098 by sheaf at 2026-09-17T02:39:13-04:00
Small refactor of lookupFamInstEnv
This commit reworks the code for looking up family instances in
GHC.Core.FamInstEnv, reducing duplication a little bit.
No change in behaviour.
- - - - -
a3ad4588 by sheaf at 2026-09-17T02:39:14-04:00
Use a type family for boxing unboxed types
This commit overhauls the way in which unboxed types are boxed, as per
the updated Note [Boxing constructors] in GHC.Builtin.WiredIn.Types.Box.
The main change is to allow boxing to be parametrised by representation,
e.g. making 'Box ty' a valid type. We achieve this by implementing 'Box'
using a closed type family:
newtype Box (a :: TYPE r) = Box (BoxTF r)
type BoxTF :: RuntimeRep -> Type
type family BoxTF r where
BoxTF IntRep = BoxInt
BoxTF Int8Rep = BoxInt8
BoxTF WordRep = BoxWord
BoxTF LiftedRep = Any @Type
BoxTF (TupleRep [r1, r2]) = (BoxTF r1, BoxTF r2)
...
BoxTF (SumRep rs) = BoxSum rs
This new design solves the following problems:
- It allows boxing a type whose 'RuntimeRep' has not yet been
determined (e.g. because we only learn the 'RuntimeRep' after
constraint solving). That is, 'Box @r a' is a perfectly valid type
even if 'r' is an unfilled metavariable. This is a requirement
to fix #25065 (in which we need to box a type whose 'RuntimeRep'
is only filled in during constraint solving).
- It handles boxing of unboxed tuples and unboxed sums, via recursive
boxing. See Note [Boxing TupleRep and SumRep] in
GHC.Builtin.WiredIn.Types.Box.
'Box', 'BoxTF' and all of the boxing data constructors are defined in
a new 'ghc-internal' module, 'GHC.Internal.Box'. This module contains
nothing but wired-in declarations, and GHC never loads its interface on
account of a wired-in thing (GHC.Builtin.Modules.isWiredInOnlyModule);
see Note [Loading instances for wired-in things] in GHC.Iface.Load.
The individual boxing data constructors are deliberately left as an
internal implementation detail, and not exported. The intended API is
via the two new magic 'Id's:
box :: forall {r} (a :: TYPE r). a -> Box a
unbox :: forall {r} (a :: TYPE r). Box a -> a
exported from 'GHC.PrimOps' (in 'ghc-experimental'). The old boxing
data types (IntBox, WordBox, FloatBox, DoubleBox, DictBox) are no longer
exported from base (CLC proposal #421).
We use this new design to consistently desugar:
- parallel comprehensions (GHC.HsToCore.ListComp.{deListComp,dsMcStmt})
- then/group/using statements (GHC.HsToCore.ListComp.{dsTransStmt,dsMcStmt})
- recursive do blocks (mdo/rec) (GHC.HsToCore.Expr.dsDo)
- arrows (GHC.HsToCore.Arrows)
by consistently using 'box'/'unbox' to deal with unboxed types being put
into big tuples. We also adapt 'GHC.Tc.Gen.Match.{tcMcStmt,tcDoStmt}'
to create fresh /representation-polymorphic/ type variables for the
binders that we are going to put into a big tuple (previously, GHC only
allowed lifted types in that position).
These desugaring of box and unbox is explained in
Note [Desugaring box & unbox] in GHC.Core.Make.Box. Roughly speaking,
the desugaring looks like:
box @r @ty e ==> K e
unbox @r @ty e ==> case e of K x -> x
where 'K' is the boxing data constructor at RuntimeRep 'r'. It's
slightly more complicated than that in practice: we first need to
insert a cast (see Note [The canonical type of a RuntimeRep]) using the
new 'CanonicalProv' 'UnivCoProvenance', and unboxed tuples/sums need
recursive logic explained in Note [box/unbox for unboxed tuples and sums],
including a specific 'BoxSum' datatypes for unboxed sum (which also
needed a wired-in type-level list indexing type family (!!)).
The desugaring happens in two ways:
- Occurrences of 'box'/'unbox' emitted by the typechecker are
eliminated in the 'ds_app_var' case of GHC.HsToCore.Expr.
- Other code that needs to box/unbox emits the appropriate code inline.
This includes the big tuple machinery of GHC.Core.Make used by the
desugarer (GHC.HsToCore.{Utils,Binds,Arrows,ListComp}) as well as
the float-out pass (GHC.Core.Opt.SetLevels).
Core Lint checks that no occurrence of 'box'/'unbox' survives desugaring.
On the way, we overhaul the litany of big tuple functions by introducing
data BigTupleLayout = BoxedElements | BareElements
to distinguish the two kinds of "big tuples" that GHC routinely deals
with; for example 'mkBigCoreVarTupSolo' becomes 'mkBigCoreVarTup BareElements'.
All of this code is moved to the new module GHC.Core.Make.BigTuple.
Fixes #20864 #22336 #22473 #25065 #27331
-------------------------
Metric Decrease:
T9872a
-------------------------
- - - - -
4cf7628a by Evgeny Malyshev at 2026-09-17T02:39:56-04:00
Fix the CompactionFailed documentation link to compact
The old Haddock reference links into base instead of ghc-compact.
Use an explicit URL because ghc-compact depends on base, not vice versa.
Fixes #27558
Assisted-By: OpenAI Codex
- - - - -
098bba70 by Facundo Domínguez at 2026-09-17T14:57:41-04:00
Remove the call to hoistFlag from processCmdLineP
This call was undesirable because it was causing a reconstruction
of the list of flag processors.
Even relying on list fusion would not be sufficient because we want
to replace the list with a data structure with faster lookups to
address #25763.
The removal is done in two moves:
* We move CmdLineP to CmdLine.hs
* Then we move the effect of hoisting to processArgs via a new function
hoistEwM
- - - - -
e01799c7 by Facundo Domínguez at 2026-09-17T14:57:42-04:00
Do not create duplicate flag processors for the -W flag
This makes simpler implementing the command line parser with a trie map
holding flag processors. If we were to allow duplicate flag processors
for any flag, the trie map would need to be a multimap.
- - - - -
3875b257 by Facundo Domínguez at 2026-09-17T14:57:42-04:00
Replace the list of flag processors with a trie map in `processArgs`
Previously `GHC.Driver.CmdLine.findArg` was called for each
command-line argument, doing a linear search on the list of flag
processors each time. This was somewhat costly as the list of flag
processor has near 2000 elements.
A lookup with a trie map is faster in general, but the speed up is
only noticeable when calling `GHC.Driver.CmdLine.processArgs` sufficient
times, so the amount of lookups piles up. This could happen in large
projects with many units each having many dependencies. If only a
module needs to be recompiled, the user still needs to wait for all of
the flag parsing to complete.
The benchmark at testsuite/tests/perf/compiler/cmdline-parser shows a
10x speed up when using the trie.
The trie map is implemented in `GHC.Data.StringTrie`.
The design is explained in Note [Processing command line argument fast]
in GHC.Driver.Session.
The commit also:
* adds two property-based tests for trie map operations,
* adds a benchmark of the command line parser, and
* renames the predicate `arg_ok` to `valid_flag_suffix` to decide what
flag processor should be used when there are multiple matching
prefixes on a flag.
Fixes #25763.
- - - - -
5236634a by Andreas Klebinger at 2026-09-17T14:58:24-04:00
Compile Word64{Map,Set} with -O2 always.
This is the hottest code and even if we build GHC with -O0 otherwise -O2
pays off for these modules.
Fixes #27814.
- - - - -
4ba35f30 by Vladislav Zavialov at 2026-09-22T16:54:01+03:00
Add regression test for #7803
Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass
methods are left unspecialized".
This change turns the example from the ticket description into a regression
test, checking that foo1 is fully specialised at Double, with no calls to the
overloaded exp5Tail.
Closes #7803
Assisted-by: Claude Opus 5
- - - - -
593 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- + changelog.d/25763-cmdline-opt
- + changelog.d/27556
- + changelog.d/27626
- + changelog.d/27627
- + changelog.d/27703
- + changelog.d/27704
- + changelog.d/27717
- + changelog.d/27732
- changelog.d/T27202
- + changelog.d/T27629
- + changelog.d/T27657
- + changelog.d/T27705
- + changelog.d/T27722-cbe-entry-block.md
- + changelog.d/T27744
- + changelog.d/T27749
- + changelog.d/T27764
- + changelog.d/T27788-js-selector
- + changelog.d/allow-gadt-prefix-con-parens
- + changelog.d/arm_ncg_fixes_T27430
- + changelog.d/boxing-family
- + changelog.d/clc-421
- + changelog.d/downsweep-refactor
- + changelog.d/fix-compacting-gc-constr-27649
- + changelog.d/fix-control0-mask-trampoline
- + changelog.d/fix-parallel-gc-selector-race-27477
- + changelog.d/fix-threadlabel-segfault-27618
- + changelog.d/implicit-field-strictness-warning
- changelog.d/lazy-field-annotations
- + changelog.d/llvm-23
- + changelog.d/ncg-x86-bit-test-instructions
- + changelog.d/rethrow-stm
- + changelog.d/select-io-manager
- + changelog.d/show-byte-code
- changelog.d/unit-index
- compiler/GHC/Builtin.hs
- compiler/GHC/Builtin/KnownKeys.hs
- compiler/GHC/Builtin/Modules.hs
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Builtin/WiredIn/Ids.hs
- compiler/GHC/Builtin/WiredIn/Prim.hs
- compiler/GHC/Builtin/WiredIn/TypeLits.hs
- compiler/GHC/Builtin/WiredIn/Types.hs
- + compiler/GHC/Builtin/WiredIn/Types/Box.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Serialize.hs
- + compiler/GHC/ByteCode/Show.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Cmm/DebugBlock.hs
- compiler/GHC/Cmm/Expr.hs
- compiler/GHC/Cmm/Lint.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Format.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- + compiler/GHC/Core/Make/BigTuple.hs
- + compiler/GHC/Core/Make/Box.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Data/FastString.hs
- + compiler/GHC/Data/StringTrie.hs
- compiler/GHC/Data/Unboxed.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Data/Word64Map/Strict.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Data/Word64Set/Internal.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/CmdLine.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main/Compile.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Driver/Session/Units.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension/Pass.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/Symbols.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Types/CompleteMatch.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/TyThing/Ppr.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit/Env.hs
- compiler/Language/Haskell/Syntax/BooleanFormula.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- configure.ac
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/exts/qualified_strings.rst
- docs/users_guide/exts/strict.rst
- docs/users_guide/exts/type_data.rst
- docs/users_guide/runtime_control.rst
- docs/users_guide/using-warnings.rst
- docs/users_guide/using.rst
- ghc/GHC/Driver/Session/Mode.hs
- ghc/GHCi/UI.hs
- ghc/Main.hs
- hadrian/README.md
- hadrian/doc/cross-compile.md
- hadrian/doc/flavours.md
- hadrian/doc/make.md
- hadrian/doc/windows.md
- hadrian/hadrian.cabal
- hadrian/hie-bios.bat
- hadrian/src/Base.hs
- hadrian/src/Builder.hs
- hadrian/src/CommandLine.hs
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Builder/Ar.hs
- hadrian/src/Hadrian/Oracles/Path.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Changelog.hs
- hadrian/src/Rules/Codes.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Rules/Nofib.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings.hs
- − hadrian/src/Settings/Flavours/Quickest.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- + libraries/base/src/Data/RealFloat.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Conc.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/GHC/RTS/Flags.hs
- libraries/base/tests/all.T
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- + libraries/ghc-internal/src/GHC/Internal/Box.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
- libraries/stm
- linters/lint-codes/LintCodes/Static.hs
- m4/find_python.m4
- + m4/fp_canonicalise_win_path.m4
- m4/fp_find_nm.m4
- m4/fp_find_root.m4
- m4/fp_prog_ar.m4
- m4/fp_prog_ar_args.m4
- m4/fp_prog_sh.m4
- m4/fptools_alex.m4
- m4/fptools_happy.m4
- rts/Capability.c
- rts/CloneStack.c
- rts/Continuation.c
- rts/ContinuationOps.cmm
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/IOManager.h
- rts/IOManagerInternals.h
- rts/Interpreter.c
- rts/Messages.c
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/Printer.c
- rts/ProfHeap.c
- rts/RaiseAsync.c
- rts/STM.c
- rts/Schedule.c
- rts/Sparks.c
- rts/StableName.c
- rts/StgMiscClosures.cmm
- rts/ThreadPaused.c
- rts/Threads.c
- rts/Threads.h
- rts/Trace.h
- rts/configure.ac
- rts/eventlog/EventLog.c
- rts/include/rts/Flags.h
- rts/include/rts/RtsToHsIface.h
- rts/include/rts/storage/Closures.h
- rts/include/stg/MiscClosures.h
- rts/linker/elf_reloc_riscv64.c
- rts/posix/Poll.c
- rts/posix/Poll.h
- rts/posix/Select.c
- + rts/posix/SelectBis.c
- + rts/posix/SelectBis.h
- rts/posix/Timeout.c
- rts/posix/Timeout.h
- rts/prim/atomic.c
- rts/rts.cabal
- rts/sm/Compact.c
- rts/sm/Evac.c
- rts/sm/GC.c
- rts/sm/GCUtils.c
- rts/sm/MBlock.c
- rts/sm/NonMoving.c
- rts/sm/NonMovingMark.c
- rts/sm/Storage.c
- rts/sm/Sweep.c
- testsuite/driver/README.md
- testsuite/driver/perf_notes.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/MiniQuickCheck.hs
- testsuite/tests/arrows/should_run/all.T
- + testsuite/tests/arrows/should_run/arrowrun005.hs
- + testsuite/tests/arrows/should_run/arrowrun005.stdout
- + testsuite/tests/bytecode/T27633/Obj.hs
- + testsuite/tests/bytecode/T27633/T27633a.hs
- + testsuite/tests/bytecode/T27633/T27633a.stdout
- + testsuite/tests/bytecode/T27633/T27633b.hs
- + testsuite/tests/bytecode/T27633/T27633b.stdout
- + testsuite/tests/bytecode/T27633/all.T
- testsuite/tests/cmm/should_compile/Makefile
- + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr
- − testsuite/tests/cmm/should_compile/T27368-ppr-debug.stdout
- testsuite/tests/cmm/should_compile/all.T
- + testsuite/tests/codeGen/should_gen_asm/T25233.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233.hs
- + testsuite/tests/codeGen/should_gen_asm/T25233b.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233b.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_run/T27430.hs
- + testsuite/tests/codeGen/should_run/T27430.stdout
- + testsuite/tests/codeGen/should_run/T27430_c.c
- + testsuite/tests/codeGen/should_run/T27533.hs
- + testsuite/tests/codeGen/should_run/T27533.stdout
- + testsuite/tests/codeGen/should_run/T27533_cmm.cmm
- + testsuite/tests/codeGen/should_run/T27537.hs
- + testsuite/tests/codeGen/should_run/T27537.stdout
- + testsuite/tests/codeGen/should_run/T27538.hs
- + testsuite/tests/codeGen/should_run/T27538.stdout
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/concurrent/should_run/T27657a.hs
- + testsuite/tests/concurrent/should_run/T27657a.stdout
- + testsuite/tests/concurrent/should_run/T27657b.hs
- + testsuite/tests/concurrent/should_run/T27657b.stdout
- testsuite/tests/concurrent/should_run/all.T
- + testsuite/tests/core-to-stg/T27627/Callee.hs
- + testsuite/tests/core-to-stg/T27627/Caller.hs
- + testsuite/tests/core-to-stg/T27627/Main.hs
- + testsuite/tests/core-to-stg/T27627/T27627.stdout
- + testsuite/tests/core-to-stg/T27627/all.T
- + testsuite/tests/core-to-stg/T27627a/Callee.hs
- + testsuite/tests/core-to-stg/T27627a/Caller.hs
- + testsuite/tests/core-to-stg/T27627a/Main.hs
- + testsuite/tests/core-to-stg/T27627a/T27627a.stdout
- + testsuite/tests/core-to-stg/T27627a/all.T
- + testsuite/tests/core-to-stg/T27627b/Callee.hs
- + testsuite/tests/core-to-stg/T27627b/Caller.hs
- + testsuite/tests/core-to-stg/T27627b/Main.hs
- + testsuite/tests/core-to-stg/T27627b/T27627b.stdout
- + testsuite/tests/core-to-stg/T27627b/all.T
- + testsuite/tests/core-to-stg/T27627c/Callee.hs
- + testsuite/tests/core-to-stg/T27627c/Caller.hs
- + testsuite/tests/core-to-stg/T27627c/Main.hs
- + testsuite/tests/core-to-stg/T27627c/T27627c.stdout
- + testsuite/tests/core-to-stg/T27627c/all.T
- + testsuite/tests/core-to-stg/T27627e.hs
- + testsuite/tests/core-to-stg/T27627e.stdout
- + testsuite/tests/core-to-stg/T27627f/Callee.hs
- + testsuite/tests/core-to-stg/T27627f/Caller.hs
- + testsuite/tests/core-to-stg/T27627f/Inst.hs
- + testsuite/tests/core-to-stg/T27627f/Main.hs
- + testsuite/tests/core-to-stg/T27627f/T27627f.stdout
- + testsuite/tests/core-to-stg/T27627f/all.T
- + testsuite/tests/core-to-stg/T27704/Callee.hs
- + testsuite/tests/core-to-stg/T27704/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27704/Main.hs
- + testsuite/tests/core-to-stg/T27704/Mid.hs
- + testsuite/tests/core-to-stg/T27704/T27704.stdout
- + testsuite/tests/core-to-stg/T27704/all.T
- + testsuite/tests/core-to-stg/T27704a/Callee.hs
- + testsuite/tests/core-to-stg/T27704a/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27704a/Main.hs
- + testsuite/tests/core-to-stg/T27704a/Mid.hs
- + testsuite/tests/core-to-stg/T27704a/T27704a.stdout
- + testsuite/tests/core-to-stg/T27704a/all.T
- + testsuite/tests/core-to-stg/T27717/Callee.hs
- + testsuite/tests/core-to-stg/T27717/Callee.hs-boot
- + testsuite/tests/core-to-stg/T27717/Main.hs
- + testsuite/tests/core-to-stg/T27717/Mid.hs
- + testsuite/tests/core-to-stg/T27717/T27717.stdout
- + testsuite/tests/core-to-stg/T27717/Ty.hs
- + testsuite/tests/core-to-stg/T27717/all.T
- testsuite/tests/core-to-stg/all.T
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/deSugar/should_compile/T25065a.hs
- testsuite/tests/deSugar/should_compile/all.T
- + testsuite/tests/deSugar/should_run/T20864.hs
- + testsuite/tests/deSugar/should_run/T20864.stdout
- + testsuite/tests/deSugar/should_run/T25065b.hs
- + testsuite/tests/deSugar/should_run/T25065b.stdout
- testsuite/tests/deSugar/should_run/all.T
- + testsuite/tests/dmdanal/should_run/M2.hs
- + testsuite/tests/dmdanal/should_run/T27626.hs
- + testsuite/tests/dmdanal/should_run/T27626.stdout
- testsuite/tests/dmdanal/should_run/all.T
- + testsuite/tests/driver/T27461/Main1.hs
- + testsuite/tests/driver/T27461/Main2.hs
- + testsuite/tests/driver/T27461/Makefile
- + testsuite/tests/driver/T27461/T27461a.stderr
- + testsuite/tests/driver/T27461/T27461b.script
- + testsuite/tests/driver/T27461/T27461b.stderr
- + testsuite/tests/driver/T27461/T27461b.stdout
- + testsuite/tests/driver/T27461/all.T
- + testsuite/tests/driver/T27461/src/Bar.hs
- testsuite/tests/driver/all.T
- + testsuite/tests/driver/stringtrie.hs
- + testsuite/tests/driver/stringtrie.stdout
- testsuite/tests/ffi/should_run/T21305.hs
- − testsuite/tests/gadt/T14320.stderr
- testsuite/tests/gadt/T18191.hs
- testsuite/tests/gadt/T18191.stderr
- + testsuite/tests/gadt/T27423a.hs
- + testsuite/tests/gadt/T27423b.hs
- + testsuite/tests/gadt/T27423b.stderr
- testsuite/tests/gadt/all.T
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.hs
- + testsuite/tests/ghci.debugger/scripts/T27633c.script
- + testsuite/tests/ghci.debugger/scripts/T27633c.stdout
- + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs
- testsuite/tests/ghci.debugger/scripts/all.T
- + testsuite/tests/ghci/prog-mhu007/Makefile
- + testsuite/tests/ghci/prog-mhu007/a/A.hs
- + testsuite/tests/ghci/prog-mhu007/all.T
- + testsuite/tests/ghci/prog-mhu007/b/B.hs
- + testsuite/tests/ghci/prog-mhu007/prog-mhu007.script
- + testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout
- + testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs
- + testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg
- + testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs
- + testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg
- + testsuite/tests/ghci/prog-mhu007/unitA
- + testsuite/tests/ghci/prog-mhu007/unitB
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- + testsuite/tests/indexed-types/should_run/T27331.hs
- + testsuite/tests/indexed-types/should_run/T27331.stdout
- + testsuite/tests/indexed-types/should_run/T27331b.hs
- + testsuite/tests/indexed-types/should_run/T27331b.stdout
- + testsuite/tests/indexed-types/should_run/T27331b_Plugin.hs
- testsuite/tests/indexed-types/should_run/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- + testsuite/tests/javascript/T27788.hs
- + testsuite/tests/javascript/T27788.stdout
- testsuite/tests/javascript/all.T
- testsuite/tests/linters/notes.stdout
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- + testsuite/tests/patsyn/should_compile/T27744.hs
- testsuite/tests/patsyn/should_compile/all.T
- + testsuite/tests/perf/compiler/T25763.stderr
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/perf/compiler/large-project/all.T
- testsuite/tests/perf/should_run/T3586.hs
- testsuite/tests/perf/should_run/T3586.stdout
- testsuite/tests/perf/space_leaks/all.T
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- + testsuite/tests/printer/Haddock1.hs
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/T18791.stderr
- + testsuite/tests/printer/T27423c.hs
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- testsuite/tests/printer/all.T
- testsuite/tests/process/process009.hs
- testsuite/tests/process/process009.stdout
- testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
- testsuite/tests/rename/should_fail/T26545.stderr
- + testsuite/tests/rts/T27477.hs
- + testsuite/tests/rts/T27477.stdout
- + testsuite/tests/rts/T27618.hs
- + testsuite/tests/rts/T27618.stdout
- + testsuite/tests/rts/T27649.hs
- + testsuite/tests/rts/T27649.stdout
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/continuations/T27651.hs
- + testsuite/tests/rts/continuations/T27651.stdout
- testsuite/tests/rts/continuations/all.T
- + testsuite/tests/show-bytecode/Example.hs
- + testsuite/tests/show-bytecode/Makefile
- + testsuite/tests/show-bytecode/all.T
- + testsuite/tests/show-bytecode/normalize
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-javascript-unknown-ghcjs
- + testsuite/tests/show-bytecode/show-bytecode-hpc.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-javascript-unknown-ghcjs
- + testsuite/tests/simd/should_run/T27565.hs
- + testsuite/tests/simd/should_run/T27565.stdout
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simplCore/should_compile/Makefile
- testsuite/tests/simplCore/should_compile/T17966.stderr
- + testsuite/tests/simplCore/should_compile/T27556.hs
- + testsuite/tests/simplCore/should_compile/T27556.script
- + testsuite/tests/simplCore/should_compile/T27629.hs
- + testsuite/tests/simplCore/should_compile/T27629.stderr
- + testsuite/tests/simplCore/should_compile/T27629Plugin.hs
- + testsuite/tests/simplCore/should_compile/T27749.hs
- + testsuite/tests/simplCore/should_compile/T27749.stderr
- testsuite/tests/simplCore/should_compile/T7785.stderr
- + testsuite/tests/simplCore/should_compile/T7803.hs
- + testsuite/tests/simplCore/should_compile/T7803.stderr
- + testsuite/tests/simplCore/should_compile/T7803a.hs
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/spec004.hs
- testsuite/tests/simplCore/should_compile/spec004.stderr
- + testsuite/tests/simplCore/should_run/T27703/Lib.hs
- + testsuite/tests/simplCore/should_run/T27703/Main.hs
- + testsuite/tests/simplCore/should_run/T27703/T27703.stdout
- + testsuite/tests/simplCore/should_run/T27703/all.T
- + testsuite/tests/simplCore/should_run/T27705.hs
- + testsuite/tests/simplCore/should_run/T27705.stdout
- + testsuite/tests/simplCore/should_run/T27705_Inst.hs
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/splice-imports/SI35.hs
- testsuite/tests/th/T17380.stderr
- testsuite/tests/th/T18612.stderr
- + testsuite/tests/th/T27034.hs
- + testsuite/tests/th/T27034.stderr
- testsuite/tests/th/T8761.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/type-data/should_fail/T27732a.hs
- + testsuite/tests/type-data/should_fail/T27732a.stderr
- + testsuite/tests/type-data/should_fail/T27732b.hs
- + testsuite/tests/type-data/should_fail/T27732b.stderr
- + testsuite/tests/type-data/should_fail/T27732c.hs
- + testsuite/tests/type-data/should_fail/T27732c.stderr
- + testsuite/tests/type-data/should_fail/T27732d.hs
- + testsuite/tests/type-data/should_fail/T27732d.stderr
- + testsuite/tests/type-data/should_fail/T27732e.hs
- + testsuite/tests/type-data/should_fail/T27732e.stderr
- + testsuite/tests/type-data/should_fail/T27732f.hs
- + testsuite/tests/type-data/should_fail/T27732f.stderr
- testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr
- testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr
- testsuite/tests/type-data/should_fail/all.T
- + testsuite/tests/typecheck/should_compile/T27664.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/warnings/should_compile/T16836a.hs
- + testsuite/tests/warnings/should_compile/T16836a.stderr
- + testsuite/tests/warnings/should_compile/T16836b.hs
- + testsuite/tests/warnings/should_compile/T16836c.hs
- + testsuite/tests/warnings/should_compile/T16836c.stderr
- + testsuite/tests/warnings/should_compile/T16836d.hs
- + testsuite/tests/warnings/should_compile/T16836d.stderr
- testsuite/tests/warnings/should_compile/all.T
- + testsuite/tests/warnings/should_fail/WExpectedNoArgError.stderr
- testsuite/tests/warnings/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/check-ppr/Main.hs
- utils/deriveConstants/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/hsc2hs
- utils/jsffi/dyld.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b74c81e3522ae18f33162470df9d2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b74c81e3522ae18f33162470df9d2f…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Change the C types of hs_{bitrev,bswap}{16,32} to match the Haskell types
by Marge Bot (＠marge-bot) 22 Sep '26
by Marge Bot (＠marge-bot) 22 Sep '26
22 Sep '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
4cc0d181 by ARATA Mizuki at 2026-09-22T08:42:55-04:00
Change the C types of hs_{bitrev,bswap}{16,32} to match the Haskell types
bitReverse{16,32}# and byteSwap{16,32}# have the type
Word# -> Word#, but their C correspondents took and
returned StgWord{16,32}.
The mismatch on bitReverse16# led to the problem reported
in #27299. Although no similar issue is reported for
bitReverse32# and byteSwap{16,32}#, it seemed wise to
change them proactively.
This commit fixes the mismatch by changing the C type.
Fixes #27299
- - - - -
43ddbbba by fendor at 2026-09-22T08:42:56-04:00
Don't lose instances from shadowed imported modules with the same name
When we look for instances below the current module, we need to check
the unit id as well when we check for whether the module is the current
module, otherwise we ignore modules we import that have the same name as
the import module.
Adds regression test.
- - - - -
16 changed files:
- + changelog.d/26610
- compiler/GHC/Driver/Env.hs
- rts/include/stg/Prim.h
- rts/prim/bitrev.c
- rts/prim/bswap.c
- + testsuite/tests/ghci/prog-mhu008/Makefile
- + testsuite/tests/ghci/prog-mhu008/a/M.hs
- + testsuite/tests/ghci/prog-mhu008/all.T
- + testsuite/tests/ghci/prog-mhu008/b/M.hs
- + testsuite/tests/ghci/prog-mhu008/prog-mhu008.script
- + testsuite/tests/ghci/prog-mhu008/prog-mhu008.stdout
- + testsuite/tests/ghci/prog-mhu008/unitA
- + testsuite/tests/ghci/prog-mhu008/unitB
- + testsuite/tests/primops/should_run/T27299.hs
- + testsuite/tests/primops/should_run/T27299.stdout
- testsuite/tests/primops/should_run/all.T
Changes:
=====================================
changelog.d/26610
=====================================
@@ -0,0 +1,7 @@
+section: compiler
+synopsis: Fix instance resolution for shadowed modules
+description:
+ Instances imported from modules with the same module name as the importing module
+ were dropped accidentally since we didn't account for the unit id of the imported module.
+mrs: !16648
+issues: #26610
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -263,13 +263,13 @@ hugCompleteSigsBelow hsc uid mn = foldr (++) [] <$>
-- | Find instances visible from the given set of imports
hugInstancesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO (InstEnv, [FamInst])
hugInstancesBelow hsc_env uid mnwib = do
- let mn = gwib_mod mnwib
+ let mn = mkModule uid (gwib_mod mnwib)
(insts, famInsts) <-
unzip . concat <$>
hugSomeThingsBelowUs (\mod_info ->
let details = hm_details mod_info
-- Don't include instances for the current module
- in if moduleName (mi_module (hm_iface mod_info)) == mn
+ in if fmap toUnitId (mi_module (hm_iface mod_info)) == mn
then []
else [(md_insts details, md_fam_insts details)])
True -- Include -hi-boot
=====================================
rts/include/stg/Prim.h
=====================================
@@ -59,16 +59,16 @@ StgWord hs_xchg32(StgWord x, StgWord val);
StgWord64 hs_xchg64(StgWord x, StgWord64 val);
/* rts/prim/bswap.c */
-StgWord16 hs_bswap16(StgWord16 x);
-StgWord32 hs_bswap32(StgWord32 x);
+StgWord hs_bswap16(StgWord x);
+StgWord hs_bswap32(StgWord x);
StgWord64 hs_bswap64(StgWord64 x);
/* rts/prim/bitrev.c
This was done as part of issue #16164.
See Note [Bit reversal primop] for more details about the implementation.*/
StgWord hs_bitrev8(StgWord x);
-StgWord16 hs_bitrev16(StgWord16 x);
-StgWord32 hs_bitrev32(StgWord32 x);
+StgWord hs_bitrev16(StgWord x);
+StgWord hs_bitrev32(StgWord x);
StgWord64 hs_bitrev64(StgWord64 x);
/* rts/prim/longlong.c */
=====================================
rts/prim/bitrev.c
=====================================
@@ -36,8 +36,8 @@ hs_bitrev8(StgWord x)
return x;
}
-StgWord16
-hs_bitrev16(StgWord16 x)
+StgWord
+hs_bitrev16(StgWord x)
{
x = ((x >> 1) & 0x5555) | ((x & 0x5555) << 1 );
x = ((x >> 2) & 0x3333) | ((x & 0x3333) << 2 );
@@ -46,14 +46,14 @@ hs_bitrev16(StgWord16 x)
return x;
}
-StgWord32
-hs_bitrev32(StgWord32 x)
+StgWord
+hs_bitrev32(StgWord x)
{
- x = ((x >> 1) & 0x55555555) | ((x & 0x55555555) << 1 );
- x = ((x >> 2) & 0x33333333) | ((x & 0x33333333) << 2 );
- x = ((x >> 4) & 0x0F0F0F0F) | ((x & 0x0F0F0F0F) << 4 );
- x = ((x >> 8) & 0x00FF00FF) | ((x & 0x00FF00FF) << 8 );
- x = ( x >> 16 ) | ( x << 16 );
+ x = ((x >> 1) & 0x55555555) | ((x & 0x55555555) << 1 );
+ x = ((x >> 2) & 0x33333333) | ((x & 0x33333333) << 2 );
+ x = ((x >> 4) & 0x0F0F0F0F) | ((x & 0x0F0F0F0F) << 4 );
+ x = ((x >> 8) & 0x00FF00FF) | ((x & 0x00FF00FF) << 8 );
+ x = ((x >> 16) & 0x0000FFFF) | ((x & 0x0000FFFF) << 16);
return x;
}
=====================================
rts/prim/bswap.c
=====================================
@@ -1,16 +1,18 @@
#include "Rts.h"
-StgWord16
-hs_bswap16(StgWord16 x)
+StgWord
+hs_bswap16(StgWord x)
{
- return ((x >> 8) | (x << 8));
+ x = (StgWord16)x;
+ return (StgWord16)((x >> 8) | (x << 8));
}
-StgWord32
-hs_bswap32(StgWord32 x)
+StgWord
+hs_bswap32(StgWord x)
{
- return ((x >> 24) | ((x >> 8) & 0xff00) |
- (x << 24) | ((x & 0xff00) << 8));
+ x = (StgWord32)x;
+ return (StgWord32)((x >> 24) | ((x >> 8) & 0xff00) |
+ (x << 24) | ((x & 0xff00) << 8));
}
StgWord64
=====================================
testsuite/tests/ghci/prog-mhu008/Makefile
=====================================
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
=====================================
testsuite/tests/ghci/prog-mhu008/a/M.hs
=====================================
@@ -0,0 +1,4 @@
+module M (T (..)) where
+
+newtype T = MkT Int
+ deriving (Eq, Ord)
=====================================
testsuite/tests/ghci/prog-mhu008/all.T
=====================================
@@ -0,0 +1,5 @@
+test('prog-mhu008',
+ [extra_files(['a/', 'b/', 'unitA', 'unitB']),
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ ghci_multiunit_script, [['unitA', 'unitB'], 'prog-mhu008.script'])
=====================================
testsuite/tests/ghci/prog-mhu008/b/M.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE PackageImports #-}
+
+module M
+ ( module Export
+ , cmp
+ ) where
+
+import "a" M as Export
+
+cmp :: T -> T -> Bool
+cmp x y = x <= y
=====================================
testsuite/tests/ghci/prog-mhu008/prog-mhu008.script
=====================================
@@ -0,0 +1,5 @@
+:set -XPackageImports
+import "a" M qualified as MA
+import "b" M qualified as MB
+
+MB.cmp (MA.MkT 1) (MA.MkT 2)
=====================================
testsuite/tests/ghci/prog-mhu008/prog-mhu008.stdout
=====================================
@@ -0,0 +1 @@
+True
=====================================
testsuite/tests/ghci/prog-mhu008/unitA
=====================================
@@ -0,0 +1,5 @@
+-this-unit-id a-0-inplace
+-this-package-name a
+-i
+-ia
+M
=====================================
testsuite/tests/ghci/prog-mhu008/unitB
=====================================
@@ -0,0 +1,6 @@
+-this-unit-id b-0-inplace
+-this-package-name b
+-package-id a-0-inplace
+-i
+-ib
+M
=====================================
testsuite/tests/primops/should_run/T27299.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE MagicHash #-}
+import GHC.Exts
+import GHC.Word
+import Numeric
+
+main :: IO ()
+main = do
+ putStrLn $ showHex (W# (bitReverse8# 0x55##)) ""
+ putStrLn $ showHex (W# (bitReverse8# 0xAA##)) ""
+ putStrLn $ showHex (W# (bitReverse16# 0x5555##)) ""
+ putStrLn $ showHex (W# (bitReverse16# 0xAAAA##)) ""
+ putStrLn $ showHex (W# (bitReverse32# 0x5555_5555##)) ""
+ putStrLn $ showHex (W# (bitReverse32# 0xAAAA_AAAA##)) ""
+ putStrLn $ showHex (W# (byteSwap16# 0xABCD##)) ""
+ putStrLn $ showHex (W# (byteSwap32# 0xABCD_EF12##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse8# 0x55##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse8# 0xAA##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse16# 0x5555##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse16# 0xAAAA##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse32# 0x5555_5555##)) ""
+ putStrLn $ showHex (W# (noinline bitReverse32# 0xAAAA_AAAA##)) ""
+ putStrLn $ showHex (W# (noinline byteSwap16# 0xABCD##)) ""
+ putStrLn $ showHex (W# (noinline byteSwap32# 0xABCD_EF12##)) ""
=====================================
testsuite/tests/primops/should_run/T27299.stdout
=====================================
@@ -0,0 +1,16 @@
+aa
+55
+aaaa
+5555
+aaaaaaaa
+55555555
+cdab
+12efcdab
+aa
+55
+aaaa
+5555
+aaaaaaaa
+55555555
+cdab
+12efcdab
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -91,3 +91,4 @@ test('T24496'
]
, compile_and_run, ['-O'])
test('T6026', normal, compile_and_run, [''])
+test('T27299', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94826f172cdf346491c288c25e9ce4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94826f172cdf346491c288c25e9ce4…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/davide/io_manager_tests] 2 commits: testsuite: Fix python type errors
by David Eichmann (＠DavidEichmann) 22 Sep '26
by David Eichmann (＠DavidEichmann) 22 Sep '26
22 Sep '26
David Eichmann pushed to branch wip/davide/io_manager_tests at Glasgow Haskell Compiler / GHC
Commits:
422a891d by David Eichmann at 2026-09-22T12:58:20+01:00
testsuite: Fix python type errors
These errors appear when using the VSCode python extension which uses
Pylance under the hood.
- - - - -
5c091995 by David Eichmann at 2026-09-22T13:05:28+01:00
Add test modifier to test over all IO Managers
- - - - -
6 changed files:
- testsuite/config/ghc
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/rts/all.T
Changes:
=====================================
testsuite/config/ghc
=====================================
@@ -257,7 +257,9 @@ def get_compiler_info():
)
except Exception as err:
- print("Exception thrown in testsuite/config/ghc.get_compiler_info: %s", err)
+ # We don't throw so that we can still discover tests before we've built
+ # GHC (i.e. config.compiler doesn't yet exist).
+ print("Exception thrown in testsuite/config/ghc.get_compiler_info: ", err)
else:
res = p.returncode == 0
@@ -315,6 +317,61 @@ def get_compiler_info():
config.ghc_th_way = "normal"
config.ghc_th_hi_ext = "hi"
+ # I/O manager discovery.
+ #
+ # Which I/O managers (GHC's `--io-manager` RTS flag) a given RTS build
+ # supports depends on the target platform and on whether the RTS is the
+ # threaded or non-threaded flavour (see rts/IOManager.h's
+ # IOMGR_ENABLED_* macros). Rather than duplicate that platform/way
+ # dependent logic here, we ask the RTS itself: giving it a bogus
+ # '--io-manager=' choice makes it print, on stderr, the list of I/O
+ # managers it was actually built to support (see IOManager.h's
+ # IOMGRS_ENABLED_STR, used when reporting the error in RtsFlags.c),
+ # which we then parse out.
+ def discover_io_managers_generic(extra_flags):
+ import tempfile
+
+ test_src = 'main :: IO ()\nmain = return ()\n'
+
+ res = [None]
+
+ with tempfile.TemporaryDirectory() as d:
+ src = Path(d) / 'IOMgrProbe.hs'
+ src.write_text(test_src)
+ exe = Path(d) / ('IoMgrProbe' + config.exeext)
+
+ # -rtsopts is needed so that the resulting binary will even
+ # consider an --io-manager= flag (rather than immediately
+ # rejecting all "unsafe" RTS options).
+ cmd = '{} -v0 -rtsopts -o {} {} {}'.format(
+ config.compiler,
+ exe,
+ src,
+ ' '.join(extra_flags))
+ try:
+ cp = subprocess.run(
+ cmd,
+ shell=True,
+ cwd=d,
+ stdout=subprocess.DEVNULL,
+ stderr=None if config.verbose >= 3 else subprocess.DEVNULL)
+ if cp.returncode != 0 or not exe.exists():
+ raise Exception("Error in testsuite/config/ghc.discover_io_managers: failed to compile with: {}".format(cmd))
+ res = list(discover_io_managers(exe, d))
+
+ except Exception as err:
+ # We don't throw so that we can still discover tests before we've built
+ # GHC (i.e. config.compiler doesn't yet exist).
+ print("Exception thrown in testsuite/config/ghc.discover_io_managers_generic: ", err)
+
+ return res
+
+ config.io_managers_nonthreaded = discover_io_managers_generic([])
+ config.io_managers_threaded = (
+ discover_io_managers_generic(['-threaded']) if config.ghc_with_threaded_rts
+ else [])
+ config.io_managers_all = list(set(config.io_managers_nonthreaded).union(set(config.io_managers_threaded)))
+
config.cmm_cpp_is_gcc = test_compile(
['-c'],
test_filename='test.cmm',
=====================================
testsuite/driver/runtests.py
=====================================
@@ -28,7 +28,7 @@ import subprocess
import asyncio
-from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
+from testutil import discover_io_managers, getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
from testglobals import getConfig, ghc_env, TestConfig, t, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -126,6 +126,15 @@ class TestConfig:
self.way_flags = {} # type: Dict[WayName, List[str]]
self.way_rts_flags = {} # type: Dict[WayName, List[str]]
+ # I/O managers (GHC's `--io-manager` RTS flag) supported by the threaded runtime.
+ self.io_managers_threaded = [] # type: List[str]
+
+ # I/O managers (GHC's `--io-manager` RTS flag) supported by the non-threaded runtime.
+ self.io_managers_nonthreaded = [] # type: List[str]
+
+ # All I/O managers (GHC's `--io-manager` RTS flag)
+ self.io_managers_all = [] # type: List[str]
+
# Do we have a functional LLVM toolchain?
self.have_llvm = False
@@ -227,7 +236,7 @@ class TestConfig:
self.allowed_perf_changes = {}
# The test environment.
- self.test_env = 'local'
+ self.test_env = TestEnv('local')
# terminal supports colors
self.supports_colors = False
@@ -366,6 +375,11 @@ class TestOptions:
# add these ways to the default set
self.extra_ways = [] # type: List[WayName]
+ # IO Managers to test
+ # * [None] - only default IO Manager
+ # * [...] - list of io managers e.g. "mio" or "poll"
+ self.io_managers = [None] # type: List[str|None]
+
# the result we normally expect for this test
self.expect = 'pass'
=====================================
testsuite/driver/testlib.py
=====================================
@@ -23,7 +23,7 @@ import subprocess
from testglobals import config, ghc_env, default_testopts, brokens, t, \
TestRun, TestResult, TestOptions, PerfMetric
-from testutil import strip_quotes, lndir, link_or_copy_file, passed, \
+from testutil import discover_io_managers, strip_quotes, lndir, link_or_copy_file, passed, \
failBecause, residency_testing_metrics, \
stable_perf_counters, \
PassFail, badResult, str_warn, str_removeprefix
@@ -190,7 +190,7 @@ def no_lint( name, opts ):
def stage1(name, opts):
# See Note [Why is there no stage1 setup function?]
- framework_fail(name, 'stage1 setup function does not exist',
+ framework_fail(name, None,
'add your test to testsuite/tests/stage1 instead')
# Note [Why is there no stage1 setup function?]
@@ -341,7 +341,7 @@ def req_th( name, opts ):
req_interp(name, opts);
if ghc_dynamic():
- return _omit_ways(name, opts, ['profasm', 'profthreaded'])
+ return _omit_ways(name, opts, [WayName('profasm'), WayName('profthreaded')])
def req_plugins( name, opts ):
"""
@@ -355,7 +355,7 @@ def req_plugins( name, opts ):
req_interp(name, opts)
# Plugins aren't supported with the external interpreter (#14335)
- expect_broken_for(14335,['ext-interp'])(name,opts)
+ expect_broken_for(IssueNumber(14335),[WayName('ext-interp')])(name,opts)
if config.cross:
opts.skip = True
@@ -569,6 +569,34 @@ def extra_ways( ways: List[WayName] ):
return helper
+# -----
+
+def _io_managers( name: TestName, opts, io_mgrs: List[str] ) -> None:
+ opts.io_managers = io_mgrs
+
+def io_managers( io_mgrs: List[str] ):
+ """
+ Further split test cases into the given IO Managers if available.
+ Available IO Managers are determined by the test case's way (threaded/non-threads) and OS.
+ You'll likely want to use `extra_ways(['threaded2'])` tif you want to test threaded IO Managers (e.g. mio).
+ """
+ return lambda name, opts: _io_managers(name, opts, io_mgrs)
+
+def all_available_io_managers( name: TestName, opts ):
+ """
+ Further split test cases into all available IO Managers.
+ Available IO Managers are determined by the test case's way (threaded/non-threads) and OS.
+ You'll likely want to use `extra_ways(['threaded2'])` to ensure threaded IO Managers are tested (e.g. mio).
+ """
+ _io_managers(name, opts, config.io_managers_all)
+
+def all_available_io_managers_except(exclude: List[str]):
+ """
+ Further split test cases into all available (except the given excluded) IO Managers.
+ Available IO Managers are determined by the test case's way (threaded/non-threads) and OS.
+ You'll likely want to use `extra_ways(['threaded2'])` to ensure threaded IO Managers are tested (e.g. mio).
+ """
+ return lambda name, opts: _io_managers(name, opts, list(set(config.io_managers_all) - set(exclude)))
# -----
@@ -661,18 +689,15 @@ def collect_size ( deviation, path ):
def collect_size_func ( deviation, path_func ):
return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path_func())) )
-def get_dir_size(path):
+def get_dir_size(path) -> int:
total = 0
- try:
- with os.scandir(path) as it:
- for entry in it:
- if entry.is_file():
- total += entry.stat().st_size
- elif entry.is_dir():
- total += get_dir_size(entry.path)
- return total
- except FileNotFoundError:
- print("Exception: Could not find: " + path)
+ with os.scandir(path) as it:
+ for entry in it:
+ if entry.is_file():
+ total += entry.stat().st_size
+ elif entry.is_dir():
+ total += get_dir_size(entry.path)
+ return total
def collect_size_dir ( deviation, path ):
return collect_size_dir_func ( deviation, lambda: path )
@@ -790,7 +815,7 @@ def find_non_inplace_so(lib):
return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),False)
-def collect_generic_stat ( metric, deviation: Optional[int], get_stat: Callable[[WayName], str]):
+def collect_generic_stat ( metric, deviation: Optional[int], get_stat: Callable[[WayName], Any]):
"""
Define a generic stat test, which computes the statistic by calling the function
given as the third argument.
@@ -1135,7 +1160,7 @@ def _collect_compiler_perf_counters(counters: Set[str], deviation: Optional[int]
# Slightly hacky, we need the requested perf_counters in 'simple_run'.
# Thus, we have to globally register these counters
opts.compiler_perf_counters += list(counters)
- _collect_stats(name, opts, counters, deviation, False, True, True)
+ _collect_stats(name, opts, counters, deviation, None, True, True)
return f
@@ -1334,21 +1359,22 @@ def check_errmsg(needle):
# grep_errmsg(regex,[groups])
# If groups are given, return only the matched groups
# that matches the regex.
-def grep_errmsg_norm(needle:str, groups = None):
+def grep_errmsg_norm(needle:str, groups_may = None):
- def get_match(str:str):
- m = re.search(needle,str)
- if m:
- return "".join([m.group(g) for g in groups if m.group(g) is not None])
- else:
- return None
-
- def norm(str) -> str:
- if groups == None:
+ def norm(string) -> str:
+ if groups_may == None:
return "".join( filter(lambda l: re.search(needle,l),
- str.splitlines(True)))
+ string.splitlines(True)))
else:
- matches = [get_match(x) for x in str.splitlines(True)]
+ groups = groups_may
+ def get_match(string: str):
+ m = re.search(needle, string)
+ if m:
+ return "".join([m.group(g) for g in groups if m.group(g) is not None])
+ else:
+ return None
+
+ matches = [get_match(x) for x in string.splitlines(True)]
res = "\n".join([x for x in matches if x])
return res
return norm
@@ -1573,6 +1599,12 @@ do_not_copy = ('.hi', '.o', '.dyn_hi'
, '.dyn_o', '.out'
,'.hi-boot', '.o-boot') # 12112
+def way_supports_io_manager(way: WayName, io_manager: None | str) -> bool:
+ if not io_manager:
+ return True
+ way_is_threaded = '-threaded' in config.way_flags[way]
+ return io_manager in config.io_managers_threaded if way_is_threaded else io_manager in config.io_managers_nonthreaded
+
async def test_common_work(name: TestName, opts,
func, args) -> None:
try:
@@ -1621,7 +1653,20 @@ async def test_common_work(name: TestName, opts,
# A test itself can request extra ways by setting opts.extra_ways
all_ways = list(OrderedDict.fromkeys(all_ways + [way for way in opts.extra_ways if way not in all_ways]))
- t.total_test_cases += len(all_ways)
+ # We run each way over each io manager (or just None meaning the default IO Manager)
+ all_ways_and_io_managers = dict(
+ (
+ way,
+ [io_manager
+ for io_manager in opts.io_managers
+ if way_supports_io_manager(way, io_manager)
+ ]
+ )
+ for way in all_ways
+ )
+
+ for io_managers in all_ways_and_io_managers.values():
+ t.total_test_cases += len(io_managers)
only_ways = getTestOpts().only_ways
ok_way = lambda way: \
@@ -1704,17 +1749,26 @@ async def test_common_work(name: TestName, opts,
# Run the required tests...
for way in do_ways:
- if stopping():
- break
- try:
- await do_test(name, way, func, args, files)
- except KeyboardInterrupt:
- stopNow()
- except Exception as e:
- traceback.print_exc()
- framework_fail(name, way, traceback.format_exc())
+ for io_manager in all_ways_and_io_managers[way]:
+ if stopping():
+ break
+ try:
+ await do_test(
+ name,
+ way,
+ io_manager,
+ func,
+ args,
+ files)
+ except KeyboardInterrupt:
+ stopNow()
+ except Exception as e:
+ traceback.print_exc()
+ framework_fail(name, way, traceback.format_exc())
+
+ for skipped_way in set(all_ways) - set(do_ways):
+ t.n_tests_skipped += len(all_ways_and_io_managers[skipped_way])
- t.n_tests_skipped += len(set(all_ways) - set(do_ways))
if getTestOpts().expect == 'missing-lib': t.n_missing_libs += 1
if config.cleanup and do_ways:
@@ -1733,6 +1787,7 @@ async def test_common_work(name: TestName, opts,
async def do_test(name: TestName,
way: WayName,
+ io_manager: None | str,
func: Callable[..., Awaitable[PassFail]],
args,
files: Set[str]
@@ -1740,6 +1795,8 @@ async def do_test(name: TestName,
opts = getTestOpts()
full_name = name + '(' + way + ')'
+ if io_manager:
+ full_name += ' (IO Manager: {})'.format(io_manager)
test_n = len(allTestNames)
progress_args = [ full_name, t.total_tests, test_n,
[len(t.unexpected_passes),
@@ -1820,7 +1877,20 @@ async def do_test(name: TestName,
# Don't continue and try to run the test if the pre_cmd fails.
return
- result = await func(*[name,way] + args)
+
+ func_has_io_manager_param = func in [
+ backpack_run,
+ compile_and_run,
+ ghci_multiunit_script,
+ ghci_script,
+ multi_compile_and_run,
+ multimod_compile_and_run,
+ warn_and_run
+ ]
+
+ io_manager_arg = [io_manager] if func_has_io_manager_param else []
+
+ result = await func(*[name,way] + io_manager_arg + args)
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
@@ -1909,7 +1979,7 @@ def framework_warn(name: TestName, way: WayName, reason: str) -> None:
# run_command.
async def run_command( name, way, cmd ):
- return await simple_run( name, '', override_options(cmd), '' )
+ return await simple_run( name, WayName(''), None, override_options(cmd), '' )
async def makefile_test( name, way, target=None ):
if target is None:
@@ -1921,7 +1991,7 @@ async def makefile_test( name, way, target=None ):
# -----------------------------------------------------------------------------
# GHCi tests
-async def ghci_script( name, way, script):
+async def ghci_script( name, way, io_manager, script):
flags = ' '.join(get_compiler_flags())
way_flags = ' '.join(config.way_flags[way])
@@ -1932,9 +2002,9 @@ async def ghci_script( name, way, script):
# NB: put way_flags before flags so that flags in all.T can override others
getTestOpts().stdin = script
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
-async def ghci_multiunit_script( name, way, units, script):
+async def ghci_multiunit_script( name, way, io_manager, units, script):
flags = ' '.join(get_compiler_flags())
way_flags = ' '.join(config.way_flags[way])
unit_flags = ' '.join(['-unit @%s' % unit for unit in units])
@@ -1946,7 +2016,7 @@ async def ghci_multiunit_script( name, way, units, script):
# NB: put way_flags before flags so that flags in all.T can override others
getTestOpts().stdin = script
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
# -----------------------------------------------------------------------------
# Compile-only tests
@@ -1995,7 +2065,7 @@ async def multi_compile_fail( name, way, top_mod, extra_mods, extra_hc_opts ):
return await do_compile( name, way, True, top_mod, extra_mods, [], extra_hc_opts)
async def make_depend( name, way, mods, extra_hc_opts ):
- return await do_compile( name, way, False, ' '.join(mods), [], [], extra_hc_opts, mode = '-M')
+ return await do_compile( name, way, False, Path(' '.join(mods)), [], [], extra_hc_opts, mode = '-M')
async def do_compile(name: TestName,
way: WayName,
@@ -2126,7 +2196,8 @@ async def compile_grep_core(name: TestName,
async def compile_and_run__(name: TestName,
way: WayName,
- top_mod: Path,
+ io_manager: None | str,
+ top_mod: Path | None,
extra_mods: List[str],
extra_hc_opts: str,
backpack: bool=False,
@@ -2168,22 +2239,22 @@ async def compile_and_run__(name: TestName,
cmd = './' + name + extension
# we don't check the compiler's stderr for a compile-and-run test
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
-async def compile_and_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts)
+async def compile_and_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts)
-async def backpack_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
+async def backpack_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts, backpack=True )
-async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ):
- return await compile_and_run__( name, way, top_mod, [], extra_hc_opts)
+async def multimod_compile_and_run( name, way, io_manager, top_mod, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, top_mod, [], extra_hc_opts)
-async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ):
- return await compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts)
+async def multi_compile_and_run( name, way, io_manager, top_mod, extra_mods, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, top_mod, extra_mods, extra_hc_opts)
-async def warn_and_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True)
+async def warn_and_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts, compile_stderr = True)
async def static_stats( name, way ):
opts = getTestOpts()
@@ -2390,7 +2461,7 @@ async def simple_build(name: Union[TestName, str],
# from /dev/null. Route output to testname.run.stdout and
# testname.run.stderr. Returns the exit code of the run.
-async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: str) -> Any:
+async def simple_run(name: TestName, way: WayName, io_manager: None | str, prog: str, extra_run_opts: str) -> Any:
opts = getTestOpts()
# figure out what to use for stdin
@@ -2409,6 +2480,9 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
my_rts_flags = rts_flags(way)
+ if io_manager:
+ my_rts_flags += ' +RTS --io-manager={0} -RTS '.format(io_manager)
+
# Collect runtime stats if necessary:
# isStatsTest and not isCompilerStatsTest():
# assume we are running a ghc compiled program. Collect stats.
@@ -2434,6 +2508,12 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
output_file = perfStatsFile(False, name)
+ # Check that IO Manager is available
+ if io_manager:
+ available_io_managers = discover_io_managers(prog, opts.testdir)
+ if io_manager not in available_io_managers:
+ framework_fail(name, way, 'IO Manager {} unexpectedly unavailable (available IO Managers: {}). `-non-threaded`/`-threaded` is only supported through way RTS flags (not manually added via test modifiers/args) when testing over IO Managers.'.format(io_manager, available_io_managers))
+
# run the command
exit_code = await runCmdPerf(opts.compiler_perf_counters, cmd, output_file,
working_dir=opts.testdir,
@@ -2495,7 +2575,7 @@ def rts_flags(way: WayName) -> str:
async def interpreter_run(name: TestName,
way: WayName,
extra_hc_opts: str,
- top_mod: Path
+ top_mod: Path | None
) -> PassFail:
opts = getTestOpts()
@@ -2866,11 +2946,11 @@ async def compare_outputs(
if config.accept_platform:
if_verbose(1, 'Accepting new output for platform "'
+ config.platform + '".')
- expected_path += '-' + config.platform
+ expected_path = Path(str(expected_path) + '-' + config.platform)
elif config.accept_os:
if_verbose(1, 'Accepting new output for os "'
+ config.os + '".')
- expected_path += '-' + config.os
+ expected_path = Path(str(expected_path) + '-' + config.os)
else:
if_verbose(1, 'Accepting new output.')
@@ -3500,7 +3580,7 @@ def find_expected_file(name: TestName, suff: str, way: WayName) -> Path:
for f in files:
if in_srcdir(f).exists():
- return f
+ return Path(f)
return basename
=====================================
testsuite/driver/testutil.py
=====================================
@@ -1,4 +1,5 @@
import os
+import re
import subprocess
import shutil
import tempfile
@@ -179,3 +180,21 @@ def shorten_metric_name(name: str) -> str:
"binary_size/if_compression(3)": "size/3",
}
return dic.get(name, name)
+
+# I/O manager discovery for a haskell binary. Returns the set of IO Manager
+# strings supported by the binary
+def discover_io_managers(hs_exe: str | Path, cwd: str | Path) -> Set[str]:
+ rp = subprocess.run(
+ [str(hs_exe), '+RTS', '--io-manager=not-a-real-io-manager', '-RTS'],
+ cwd=cwd,
+ stdout=subprocess.DEVNULL,
+ stderr=subprocess.PIPE)
+ stderr = rp.stderr.decode('utf-8', errors='replace')
+
+ m = re.search(r'choices are:\s*(.*)', stderr)
+ if not m:
+ raise Exception("Expected stderr output of form 'choices are: ...' but got: {}".format(stderr))
+
+ # 'auto' is a meta-choice (let the RTS pick a default for us), not
+ # an I/O manager implementation in its own right.
+ return set(m.group(1).split()) - {'auto'}
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -662,8 +662,9 @@ test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142'
test('T23400', [], compile_and_run, ['-with-rtsopts -A8k'])
test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), skip),
- pre_cmd('$MAKE -s --no-print-directory IOManager.hs')],
- compile_and_run, [''])
+ pre_cmd('$MAKE -s --no-print-directory IOManager.hs'),
+ extra_ways(['threaded2']), all_available_io_managers_except('winio')],
+ compile_and_run, [''])
test('T24142', [req_target_smp], compile_and_run, ['-threaded -with-rtsopts "-N2"'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1555161e4183027f664c2a96a5add2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1555161e4183027f664c2a96a5add2…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/mangoiv/27817] 6 commits: Remove the call to hoistFlag from processCmdLineP
by Magnus (＠MangoIV) 22 Sep '26
by Magnus (＠MangoIV) 22 Sep '26
22 Sep '26
Magnus pushed to branch wip/mangoiv/27817 at Glasgow Haskell Compiler / GHC
Commits:
098bba70 by Facundo Domínguez at 2026-09-17T14:57:41-04:00
Remove the call to hoistFlag from processCmdLineP
This call was undesirable because it was causing a reconstruction
of the list of flag processors.
Even relying on list fusion would not be sufficient because we want
to replace the list with a data structure with faster lookups to
address #25763.
The removal is done in two moves:
* We move CmdLineP to CmdLine.hs
* Then we move the effect of hoisting to processArgs via a new function
hoistEwM
- - - - -
e01799c7 by Facundo Domínguez at 2026-09-17T14:57:42-04:00
Do not create duplicate flag processors for the -W flag
This makes simpler implementing the command line parser with a trie map
holding flag processors. If we were to allow duplicate flag processors
for any flag, the trie map would need to be a multimap.
- - - - -
3875b257 by Facundo Domínguez at 2026-09-17T14:57:42-04:00
Replace the list of flag processors with a trie map in `processArgs`
Previously `GHC.Driver.CmdLine.findArg` was called for each
command-line argument, doing a linear search on the list of flag
processors each time. This was somewhat costly as the list of flag
processor has near 2000 elements.
A lookup with a trie map is faster in general, but the speed up is
only noticeable when calling `GHC.Driver.CmdLine.processArgs` sufficient
times, so the amount of lookups piles up. This could happen in large
projects with many units each having many dependencies. If only a
module needs to be recompiled, the user still needs to wait for all of
the flag parsing to complete.
The benchmark at testsuite/tests/perf/compiler/cmdline-parser shows a
10x speed up when using the trie.
The trie map is implemented in `GHC.Data.StringTrie`.
The design is explained in Note [Processing command line argument fast]
in GHC.Driver.Session.
The commit also:
* adds two property-based tests for trie map operations,
* adds a benchmark of the command line parser, and
* renames the predicate `arg_ok` to `valid_flag_suffix` to decide what
flag processor should be used when there are multiple matching
prefixes on a flag.
Fixes #25763.
- - - - -
5236634a by Andreas Klebinger at 2026-09-17T14:58:24-04:00
Compile Word64{Map,Set} with -O2 always.
This is the hottest code and even if we build GHC with -O0 otherwise -O2
pays off for these modules.
Fixes #27814.
- - - - -
04aecb97 by mangoiv at 2026-09-22T12:22:12+02:00
ci: move hadrian/ghci into the lint category so it can be picked up by more runners
Fixes #27817
- - - - -
a14b3f58 by mangoiv at 2026-09-22T12:22:14+02:00
ci: make lint-adjacent jobs into platform independent
- move lint jobs into lint-anyarch tag
- unify lint jobs under the same platform independent container
- - - - -
18 changed files:
- .gitlab-ci.yml
- + changelog.d/25763-cmdline-opt
- + compiler/GHC/Data/StringTrie.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Data/Word64Set/Internal.hs
- compiler/GHC/Driver/CmdLine.hs
- compiler/GHC/Driver/Session.hs
- compiler/ghc.cabal.in
- ghc/GHC/Driver/Session/Mode.hs
- testsuite/tests/MiniQuickCheck.hs
- testsuite/tests/driver/all.T
- + testsuite/tests/driver/stringtrie.hs
- + testsuite/tests/driver/stringtrie.stdout
- + testsuite/tests/perf/compiler/T25763.stderr
- testsuite/tests/perf/compiler/all.T
- + testsuite/tests/warnings/should_fail/WExpectedNoArgError.stderr
- testsuite/tests/warnings/should_fail/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -137,15 +137,37 @@ workflow:
.lint:
stage: tool-lint
tags:
- - lint
- before_script:
- # Allow Git to read from the runner-owned checkout. This is needed
- # for example by the lint-author job.
- - git config --global --add safe.directory "$CI_PROJECT_DIR"
+ - lint-anyarch
+ image: debian:13
rules:
- *drafts-can-fail-lint
- when: always
+.install-ghc-toolchain: &install-ghc-toolchain
+ - apt update
+ - apt install -qy build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses6 libtinfo6 pkg-config python3 cmake git happy alex autoconf automake python3 libgmp-dev libnuma-dev libncurses-dev
+ - curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
+ - source /root/.ghcup/env
+ - ghcup --no-verbose install ghc --set --install-targets 'install_bin install_lib update_package_db' '9.10'
+ - ghcup --no-verbose install cabal --set
+ - ghc --info
+ - cabal --version
+
+# linting but we need a boot toolchain
+.lint-ghc-toolchain:
+ extends: .lint
+ before_script:
+ - *install-ghc-toolchain
+ - git config --global --add safe.directory "$CI_PROJECT_DIR"
+
+# linting but we need python
+.lint-python:
+ extends: .lint
+ before_script:
+ - apt update
+ - apt install -qy python3 mypy shellcheck git
+ - git config --global --add safe.directory "$CI_PROJECT_DIR"
+
.nightly: &nightly
variables:
XZ_OPT: "-9"
@@ -217,11 +239,11 @@ not-interruptible:
stage: not-interruptible
script: "true"
interruptible: false
- image: "debian:13"
+ image: debian:13
variables:
GIT_STRATEGY: none
tags:
- - lint
+ - lint-anyarch
rules:
# - if: '$CI_COMMIT_BRANCH == "master"'
# when: always
@@ -242,7 +264,6 @@ include: '.gitlab/jobs.yaml'
ghc-linters:
stage: tool-lint
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
extends: .lint-params
variables:
BUILD_FLAVOUR: default
@@ -258,16 +279,11 @@ ghc-linters:
# Skipped if the MR has the ~"no-changelog" label.
lint-changelog:
stage: tool-lint
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
- extends: .lint
+ extends: .lint-ghc-toolchain
variables:
CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID"
GIT_DEPTH: 1
GIT_SUBMODULE_STRATEGY: none
- before_script:
- - export PATH="/opt/toolchain/bin:$PATH"
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- .gitlab/ci.sh lint_changelog
dependencies: []
@@ -279,42 +295,30 @@ lint-changelog:
# Run mypy Python typechecker on linter scripts.
lint-linters:
- image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
- extends: .lint
+ extends: .lint-python
variables:
GIT_DEPTH: 1
GIT_SUBMODULE_STRATEGY: none
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- mypy testsuite/tests/linters/regex-linters/*.py
dependencies: []
# Check that .T files all parse by listing broken tests.
lint-testsuite:
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
- extends: .lint
+ extends: .lint-ghc-toolchain
variables:
GIT_DEPTH: 1
GIT_SUBMODULE_STRATEGY: none
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- - make -Ctestsuite list_broken TEST_HC=$GHC
+ - make -Ctestsuite list_broken TEST_HC=$(which ghc)
dependencies: []
# Run mypy Python typechecker on testsuite driver
typecheck-testsuite:
- image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
- extends: .lint
+ extends: .lint-python
variables:
GIT_DEPTH: 1
GIT_SUBMODULE_STRATEGY: none
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- mypy testsuite/driver/runtests.py
dependencies: []
@@ -323,7 +327,6 @@ typecheck-testsuite:
# accommodate, e.g., haddock changes not yet upstream) but not on `master` or
# Marge jobs.
.lint-submods:
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
extends: .lint-params
variables:
BUILD_FLAVOUR: default
@@ -341,13 +344,9 @@ typecheck-testsuite:
# Check that commits in an MR were not authored with the identity that CI uses
# when it needs to create commits itself. This only needs Git history.
lint-author:
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
- extends: .lint
+ extends: .lint-python
variables:
GIT_SUBMODULE_STRATEGY: none
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME
- base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)"
@@ -425,12 +424,9 @@ lint-submods-branch:
.lint-params:
needs: []
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
extends: .lint
before_script:
- - export PATH="/opt/toolchain/bin:$PATH"
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
+ - *install-ghc-toolchain
- .gitlab/ci.sh setup
after_script:
- .gitlab/ci.sh save_cache
@@ -448,18 +444,13 @@ lint-submods-branch:
hadrian-ghc-in-ghci:
stage: quick-build
+ extends: .lint-ghc-toolchain
needs:
- job: lint-linters
- job: lint-submods
optional: true
- image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
variables:
GHC_FLAGS: -Werror -Wwarn=unused-imports
- tags:
- - x86_64-linux
script:
- git clean -xdf && git submodule foreach git clean -xdf
- . .gitlab/ci.sh setup
@@ -493,9 +484,6 @@ hadrian-multi:
optional: true
dependencies: null
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
variables:
GHC_FLAGS: "-Werror=-Wno-error=incomplete-record-selectors -Wwarn=deprecations -Wwarn=unused-imports"
# -Wno-error=incomplete-record-selectors is present because -Wall now
@@ -1055,9 +1043,6 @@ perf:
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV"
tags:
- x86_64-linux-perf
- before_script:
- # workaround for docker permissions
- - sudo chown ghc:ghc -R .
script:
- root=$(pwd)/ghc
- |
=====================================
changelog.d/25763-cmdline-opt
=====================================
@@ -0,0 +1,19 @@
+section: compiler
+synopsis: Speed up command line parser with a trie map
+description:
+ Parsing flags is now faster when there are many flags to parse.
+
+ There is a new trie implementation with String keys in ``GHC.Data.StringTrie``.
+
+ Added a new abstract type ``FlagSpecTrie`` to represent tries of flags.
+
+ ``GHC.Driver.Session`` gets ``flagsDynamic`` removed and ``flagsDynamicTrie``
+ added with type ``FlagSpecTrie``. ``processCmdLineP`` and ``parseDynamicFlagsFull``
+ now have a ``FlagSpecTrie`` parameter instead of a list.
+
+ ``GHC.Driver.Session.Mode`` gets a value ``mode_flags_trie`` of type ``FlagSpecTrie``.
+
+ ``GHC.Driver.CmdLine.processArgs`` now gets a ``FlagSpecTrie`` argument instead
+ of a list.
+mrs: !16392
+issues: #25763
=====================================
compiler/GHC/Data/StringTrie.hs
=====================================
@@ -0,0 +1,148 @@
+module GHC.Data.StringTrie
+ ( StringTrie(..)
+ , empty
+ , insert
+ , fromList
+ , fromListWithSparseness
+ , lookup
+ ) where
+
+import GHC.Prelude hiding (lookup)
+
+import Data.Array (Array, accumArray, assocs)
+import Data.Maybe (fromMaybe)
+import qualified Data.IntMap.Lazy as M
+
+-- | A trie mapping strings to values of type @a@.
+--
+-- See #25763 and Note [Optimising the processing of command-line arguments]
+-- in "GHC.Driver.Session".
+data StringTrie a
+ = -- | A value and other children under the same path.
+ --
+ -- The 'IntMap' can be empty.
+ STNode a (M.IntMap (StringTrie a))
+ -- | There is no value at this path, but there are children under it
+ --
+ -- The 'IntMap' must be non-empty, so 'STEmpty' remains the only way to
+ -- represent a trie with no values.
+ | STFork (M.IntMap (StringTrie a))
+ -- | A trie with no values
+ | STEmpty
+ deriving (Eq, Show)
+
+-- | There are no key-value pairs in this trie.
+empty :: StringTrie a
+empty = STEmpty
+
+-- | Inserts a key-value pair into the trie. When a value for the key is already
+-- present, the new value replaces the old one.
+insert :: forall a. String -> a -> StringTrie a -> StringTrie a
+insert k0 v = go k0
+ where
+ go :: String -> StringTrie a -> StringTrie a
+ go (x:xs) STEmpty = STFork $ M.singleton (fromEnum x) (go xs STEmpty)
+ go "" STEmpty = STNode v M.empty
+ go "" (STFork children) = STNode v children
+ go (x:xs) (STFork children) =
+ STFork (M.insert (fromEnum x) child children)
+ where
+ child = go xs (fromMaybe empty $ M.lookup (fromEnum x) children)
+
+ go "" (STNode _ children) = STNode v children
+ go (x:xs) (STNode vs children) =
+ STNode vs (M.insert (fromEnum x) child children)
+ where
+ child = go xs (fromMaybe empty $ M.lookup (fromEnum x) children)
+
+-- | Returns the values associated with prefixes of a query string as well as
+-- the non-matching suffix. The matches are returned ordered by suffix length.
+--
+-- Examples:
+--
+-- > lookup "abc" (fromList [("ab", 2), ("abc", 3), ("b", 4)]) == [(3, ""), (2, "c")]
+-- > lookup "abc" (fromList [("ab", 2), ("ab", 3)]) == [(3, "c")]
+-- > lookup "ba" (fromList [("ab", 2), ("abc", 3)]) == []
+--
+-- More formally:
+--
+-- @(v, suffix)@ is in @lookup queryString t@ iff there is a string @k@ such that
+-- * @(k, v)@ is in @t@, and
+-- * @k ++ suffix == queryString@.
+lookup
+ :: String
+ -> StringTrie a
+ -> [(a, String)]
+lookup = go []
+ where
+ go :: [(a, String)] -> String -> StringTrie a -> [(a, String)]
+ --
+ -- In @lookup queryString t@ and @go acc unmatchedSuffix t'@,
+ --
+ -- unmatchedSuffix is a suffix of queryString, and t' is the subtrie
+ -- of t at path @queryString - unmatchedSuffix@.
+ --
+ -- (v, suffix) is in acc iff there is a k such that
+ -- * (k, v) is in t, and
+ -- * @k ++ suffix == queryString@, and
+ -- * @unmatchedSuffix /= suffix@.
+ go acc [] (STNode v _) = (v, "") : acc
+ go acc [] (STFork _) = acc
+ go acc _ STEmpty = acc
+ go acc unmatchedSuffix@(c:rest) (STNode v children) =
+ let acc' = (v, unmatchedSuffix) : acc
+ in maybe acc' (go acc' rest) (M.lookup (fromEnum c) children)
+ go acc (c:rest) (STFork children) =
+ maybe acc (go acc rest) (M.lookup (fromEnum c) children)
+
+-- | Constructs a trie from a list of key-value pairs.
+--
+-- Later entries in the list will overwrite earlier ones with the same key.
+--
+-- Equivalent to @foldl (\t (k, v) -> insert k v t) empty@, but lazier: the
+-- subtrie for each first character is only built when demanded.
+fromList :: [(String, a)] -> StringTrie a
+fromList = fromListWithSparseness 32
+
+-- | Like 'fromList', but allows the caller to specify a threshold for when to use
+-- an array to sort the keys.
+fromListWithSparseness :: Int -> [(String, a)] -> StringTrie a
+fromListWithSparseness sparseness = go
+ where
+ go [] = STEmpty
+ go xs =
+ let revxs = reverse xs
+ valuesWithEmptyKeys = filter (null . fst) revxs
+ children = M.map go (headBuckets sparseness revxs)
+ in case valuesWithEmptyKeys of
+ (_, v) : _ -> STNode v children
+ _ -> STFork children
+
+ -- Group the entries with a non-empty key by their first character (in reverse order).
+ --
+ -- Discards entries with an empty key. Uses an array to sort the entries, unless the
+ -- entries are too sparse.
+ headBuckets :: Int -> [(String, a)] -> M.IntMap [(String, a)]
+ headBuckets sparseness kvs
+ -- Entries are too sparse if they are too few or if they span too large a range
+ -- of characters.
+ | null (drop sparseness kvs) || any non_ascii kvs
+ = M.fromListWith (++) [ (fromEnum c, [(cs, v)]) | (c:cs, v) <- kvs ]
+ | otherwise
+ = M.fromDistinctAscList
+ [ (i, group) | (i, group) <- assocs (bucketsArr kvs), not (null group) ]
+
+ -- @(k, v)@ is in @bucketsArr kvs ! i@ iff @(tail k, v)@ is in @kvs@ and
+ -- @fromEnum (head k) == i@.
+ --
+ -- Note: Discard entries with an empty key.
+ bucketsArr :: [(String, a)] -> Array Int [(String, a)]
+ bucketsArr kvs =
+ accumArray
+ (flip (:))
+ []
+ (0, 0x7f)
+ [ (fromEnum c, (cs, v)) | (c:cs, v) <- kvs ]
+
+ non_ascii (c:_, _) = fromEnum c > 0x7f
+ non_ascii ([], _) = False
=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -3,6 +3,8 @@
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+-- Speeds up otherwise unoptimized ghcs by 5-25% (#27814)
+{-# OPTIONS_GHC -O2 #-}
-----------------------------------------------------------------------------
=====================================
compiler/GHC/Data/Word64Map/Strict/Internal.hs
=====================================
@@ -1,5 +1,7 @@
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+-- Speeds up otherwise unoptimized ghcs by 5-25% (#27814)
+{-# OPTIONS_GHC -O2 #-}
-----------------------------------------------------------------------------
-- |
=====================================
compiler/GHC/Data/Word64Set/Internal.hs
=====================================
@@ -2,6 +2,8 @@
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK not-home #-}
+-- Speeds up otherwise unoptimized ghcs by 5-25% (#27814)
+{-# OPTIONS_GHC -O2 #-}
-----------------------------------------------------------------------------
-- |
=====================================
compiler/GHC/Driver/CmdLine.hs
=====================================
@@ -1,8 +1,9 @@
+{-# LANGUAGE BangPatterns #-}
-------------------------------------------------------------------------------
--
-- | Command-line parser
--
--- This is an abstract command-line parser used by DynFlags.
+-- This is a command-line parser used by DynFlags.
--
-- (c) The University of Glasgow 2005
--
@@ -10,13 +11,26 @@
module GHC.Driver.CmdLine
(
- processArgs, parseResponseFile, OptKind(..), GhcFlagMode(..),
- Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag, hoistFlag,
- errorsToGhcException,
+ processArgs,
+
+ -- ** Flags
+ Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
+ OptKind(..), GhcFlagMode(..),
+
+ -- ** EwM monad
+ EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM,
Err(..), Warn, warnsToMessages,
- EwM, runEwM, addErr, addWarn, addFlagWarn, getArg, getCurLoc, liftEwM
+ -- ** FlagSpecTrie
+ FlagSpecTrie, mkFlagSpecTrie, extendFlagSpecTrie,
+
+ -- ** State
+ CmdLineP(..), runCmdLineP,
+ getCmdLineState, putCmdLineState,
+
+ -- ** Utils
+ parseResponseFile, errorsToGhcException
) where
import GHC.Prelude
@@ -24,6 +38,7 @@ import GHC.Prelude
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Data.Bag
+import qualified GHC.Data.StringTrie as StringTrie
import GHC.Types.SrcLoc
import GHC.Types.Error
import GHC.Utils.Error
@@ -31,14 +46,16 @@ import GHC.Driver.Errors.Types
import GHC.Driver.Errors.Ppr () -- instance Diagnostic DriverMessage
import GHC.Utils.Outputable (text)
-import Data.Function
-import Data.List (sortBy, intercalate, stripPrefix)
+import Data.List (intercalate)
import Data.Word
import GHC.ResponseFile
import Control.Exception (IOException, catch)
import Control.Monad (ap)
import Control.Monad.IO.Class
+import Control.Monad.Trans.State (StateT)
+import qualified Control.Monad.Trans.State as State
+import Data.Functor.Identity (runIdentity)
--------------------------------------------------------
-- The Flag and OptKind types
@@ -62,24 +79,6 @@ defGhciFlag name optKind = Flag name optKind OnlyGhci
defHiddenFlag :: String -> OptKind m -> Flag m
defHiddenFlag name optKind = Flag name optKind HiddenFlag
-hoistFlag :: forall m n. (forall a. m a -> n a) -> Flag m -> Flag n
-hoistFlag f (Flag a b c) = Flag a (go b) c
- where
- go (NoArg k) = NoArg (go2 k)
- go (HasArg k) = HasArg (\s -> go2 (k s))
- go (SepArg k) = SepArg (\s -> go2 (k s))
- go (Prefix k) = Prefix (\s -> go2 (k s))
- go (OptPrefix k) = OptPrefix (\s -> go2 (k s))
- go (OptIntSuffix k) = OptIntSuffix (\n -> go2 (k n))
- go (IntSuffix k) = IntSuffix (\n -> go2 (k n))
- go (Word64Suffix k) = Word64Suffix (\s -> go2 (k s))
- go (FloatSuffix k) = FloatSuffix (\s -> go2 (k s))
- go (PassFlag k) = PassFlag (\s -> go2 (k s))
- go (AnySuffix k) = AnySuffix (\s -> go2 (k s))
-
- go2 :: EwM m a -> EwM n a
- go2 (EwM g) = EwM $ \loc es ws -> f (g loc es ws)
-
-- | GHC flag modes describing when a flag has an effect.
data GhcFlagMode
= OnlyGhc -- ^ The flag only affects the non-interactive GHC
@@ -159,6 +158,9 @@ getCurLoc = EwM (\(L loc _) es ws -> return (es, ws, loc))
liftEwM :: Monad m => m a -> EwM m a
liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
+hoistEwM :: (forall a. m a -> n a) -> EwM m b -> EwM n b
+hoistEwM f (EwM g) = EwM $ \loc es ws -> f (g loc es ws)
+
warnsToMessages :: DiagOpts -> [Warn] -> Messages DriverMessage
warnsToMessages diag_opts = foldr
(\(L loc w) ws -> addMessage (mkPlainMsgEnvelope diag_opts loc w) ws)
@@ -168,20 +170,70 @@ warnsToMessages diag_opts = foldr
-- Processing arguments
--------------------------------------------------------
-processArgs :: Monad m
- => [Flag m] -- ^ cmdline parser spec
- -> [Located String] -- ^ args
- -> (FilePath -> EwM m [Located String]) -- ^ response file handler
- -> m ( [Located String], -- spare args
+newtype CmdLineP s a = CmdLineP (forall m. (Monad m) => StateT s m a)
+ deriving (Functor)
+
+instance Monad (CmdLineP s) where
+ CmdLineP k >>= f = CmdLineP (k >>= \x -> case f x of CmdLineP g -> g)
+ return = pure
+
+instance Applicative (CmdLineP s) where
+ pure x = CmdLineP (pure x)
+ (<*>) = ap
+
+getCmdLineState :: CmdLineP s s
+getCmdLineState = CmdLineP State.get
+
+putCmdLineState :: s -> CmdLineP s ()
+putCmdLineState x = CmdLineP (State.put x)
+
+runCmdLineP :: CmdLineP s a -> s -> (a, s)
+runCmdLineP (CmdLineP k) s0 = runIdentity $ State.runStateT k s0
+
+-- | Flag specifications as a trie map
+--
+-- No two flags with the same 'flagName' are allowed.
+--
+-- See Note [Optimising the processing of command-line arguments]
+-- in GHC.Driver.Session.
+newtype FlagSpecTrie s =
+ -- | The key of each 'Flag' @f@ is @flagName f@.
+ FlagSpecTrie { unFlagSpecTrie :: StringTrie.StringTrie (Flag (CmdLineP s)) }
+
+-- | Construct a 'FlagSpecTrie' from a list of flags.
+--
+-- Precondition: No two flags in the list have the same flag name.
+mkFlagSpecTrie :: [Flag (CmdLineP s)] -> FlagSpecTrie s
+mkFlagSpecTrie flags =
+ FlagSpecTrie $ StringTrie.fromList [ (flagName f, f) | !f <- flags ]
+{-# INLINE mkFlagSpecTrie #-}
+
+-- | Add flags to an existing 'FlagSpecTrie'.
+--
+-- Precondition: No two flags in the trie plus the list have the same flag name.
+extendFlagSpecTrie :: FlagSpecTrie s -> [Flag (CmdLineP s)] -> FlagSpecTrie s
+extendFlagSpecTrie (FlagSpecTrie t) flags =
+ FlagSpecTrie $ foldl' (\acc f -> StringTrie.insert (flagName f) f acc) t flags
+{-# INLINE extendFlagSpecTrie #-}
+
+processArgs :: forall s m. Monad m
+ => FlagSpecTrie s -- ^ cmdline parser spec
+ -> [Located String] -- ^ args
+ -> (FilePath -> EwM (StateT s m) [Located String]) -- ^ response file handler
+ -> StateT s m
+ ( [Located String], -- spare args
[Err], -- errors
Warns ) -- warnings
processArgs spec args handleRespFile = do
(errs, warns, spare) <- runEwM action
return (spare, bagToList errs, warns)
where
+ getCmdLineP :: CmdLineP s a -> StateT s m a
+ getCmdLineP (CmdLineP k) = k
+
action = process args []
- -- process :: [Located String] -> [Located String] -> EwM m [Located String]
+ process :: [Located String] -> [Located String] -> EwM (StateT s m) [Located String]
process [] spare = return (reverse spare)
process (L _ ('@' : resp_file) : args) spare = do
@@ -189,7 +241,7 @@ processArgs spec args handleRespFile = do
process (resp_args ++ args) spare
process (locArg@(L _ ('-' : arg)) : args) spare =
- case findArg spec arg of
+ case findArg (unFlagSpecTrie spec) arg of
Just (rest, opt_kind) ->
case processOneArg opt_kind rest arg args of
Left err ->
@@ -198,7 +250,7 @@ processArgs spec args handleRespFile = do
Right (action,rest) ->
let b = process rest spare
- in (setArg locArg $ action) >> b
+ in setArg locArg (hoistEwM getCmdLineP action) >> b
Nothing -> process args (locArg : spare)
@@ -246,31 +298,38 @@ processOneArg opt_kind rest arg args
OptPrefix f -> Right (f rest_no_eq, args)
AnySuffix f -> Right (f dash_arg, args)
-findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
-findArg spec arg =
- case sortBy (compare `on` (length . fst)) -- prefer longest matching flag
- [ (removeSpaces rest, optKind)
- | flag <- spec,
- let optKind = flagOptKind flag,
- Just rest <- [stripPrefix (flagName flag) arg],
- arg_ok optKind rest arg ]
- of
- [] -> Nothing
- (one:_) -> Just one
-
-arg_ok :: OptKind t -> [Char] -> String -> Bool
-arg_ok (NoArg _) rest _ = null rest
-arg_ok (HasArg _) _ _ = True
-arg_ok (SepArg _) rest _ = null rest
-arg_ok (Prefix _) _ _ = True -- Missing argument checked for in processOneArg t
- -- to improve error message (#12625)
-arg_ok (OptIntSuffix _) _ _ = True
-arg_ok (IntSuffix _) _ _ = True
-arg_ok (Word64Suffix _) _ _ = True
-arg_ok (FloatSuffix _) _ _ = True
-arg_ok (OptPrefix _) _ _ = True
-arg_ok (PassFlag _) rest _ = null rest
-arg_ok (AnySuffix _) _ _ = True
+-- | Find a flag in the trie whose name is a prefix of the given string.
+--
+-- The unmatched suffix of the string is returned along with the 'OptKind'.
+--
+-- A flag is only returned if the suffix is valid for the 'OptKind' of the flag.
+-- For example, a flag with 'NoArg' will only be returned if the suffix is
+-- empty. More concretely, @-Wallx@ will produce an invalid suffix @"x"@ since
+-- @-Wall@ has @OptKind@ 'NoArg'.
+--
+-- If more than one flag name is a prefix of the string, the longest match with
+-- a valid suffix is returned.
+findArg :: StringTrie.StringTrie (Flag m) -> String -> Maybe (String, OptKind m)
+findArg trie arg =
+ case filter (uncurry valid_flag_suffix) $ StringTrie.lookup arg trie of
+ [] -> Nothing
+ (flag, rest) : _ -> Just (removeSpaces rest, flagOptKind flag)
+ where
+ valid_flag_suffix :: Flag m -> String -> Bool
+ valid_flag_suffix flag rest =
+ case flagOptKind flag of
+ NoArg _ -> null rest
+ HasArg _ -> True
+ SepArg _ -> null rest
+ Prefix _ -> True -- Missing argument checked for in processOneArg t
+ -- to improve error message (#12625)
+ OptIntSuffix _ -> True
+ IntSuffix _ -> True
+ Word64Suffix _ -> True
+ FloatSuffix _ -> True
+ OptPrefix _ -> True
+ PassFlag _ -> null rest
+ AnySuffix _ -> True
-- | Parse an Int
--
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -181,7 +181,8 @@ module GHC.Driver.Session (
-- ** Available DynFlags
allNonDeprecatedFlags,
flagsAll,
- flagsDynamic,
+ flagsAllTrie,
+ flagsDynamicTrie,
flagsPackage,
flagsForCompletion,
@@ -294,8 +295,7 @@ import System.Semaphore ( getSemaphoreProtocolVersion, semaphoreVersion )
import Data.IORef
import Control.Arrow ((&&&))
import Control.Monad
-import Control.Monad.Trans.State as State
-import Data.Functor.Identity
+import Control.Monad.Trans.State (runStateT)
import Data.Ord
import Data.Char
@@ -391,6 +391,37 @@ import Language.Haskell.Syntax.Text
--
-- See #4437 and #8176.
+-- Note [Optimising the processing of command-line arguments]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- For each command line argument we need to search all the possible flag names to
+-- find the correct command-line argument processor (of type `CmdLineP DynFlags`)
+-- to complete parsing of the argument and modify the `DynFlags`.
+--
+-- GHC has a LOT of flags, and occasionally, users give a LOT of command line
+-- arguments. So in some cases it pays to optimize the search for a command-line
+-- argument processor (#25763).
+--
+-- An additional complication is that flag specs need to be looked up with a
+-- string that may contain the flag key as a prefix.
+--
+-- In general, the `=` sign is optional, and anything after the name of the flag,
+-- if it doesn't start with `=`, is considered the argument. E.g.
+-- `-odirsome/path`, or `-pgmFprogram`, or `-package-dbDiff`, or `-optc-DFOO`,
+-- or `-Isome/path`, or `-fpluginLiquidHaskell`, or `-fplugin-optLiquidHaskell:--save`.
+--
+-- To achieve this:
+--
+-- * We build global lookup tables
+-- * GHC.Driver.Session.flagsAllTrie :: FlagSpecTrie DynFlags
+-- * GHC.Driver.Session.flagsDynamicTrie :: FlagSpecTrie DynFlags
+-- * GHC.Driver.Session.Mode.mode_flags_trie :: FlagSpecTrie ModeMS
+--
+-- These are implemented by a trie indexed by Strings, see GHC.Data.StringTrie.
+--
+-- * As we process each command line argument, one by one, we
+-- look up in the `FlagSpecTrie` to find which processor
+-- to use. See `GHC.Driver.CmdLine.processArgs`.
+
-- -----------------------------------------------------------------------------
-- DynFlags
@@ -837,7 +868,7 @@ parseDynamicFlagsCmdLine :: MonadIO m => Logger -> DynFlags -> [Located String]
-> m (DynFlags, [Located String], Messages DriverMessage)
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
-parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True
+parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAllTrie True
-- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags
@@ -847,42 +878,19 @@ parseDynamicFilePragma :: MonadIO m => Logger -> DynFlags -> [Located String]
-> m (DynFlags, [Located String], Messages DriverMessage)
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
-parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False
-
-newtype CmdLineP s a = CmdLineP (forall m. (Monad m) => StateT s m a)
- deriving (Functor)
-
-instance Monad (CmdLineP s) where
- CmdLineP k >>= f = CmdLineP (k >>= \x -> case f x of CmdLineP g -> g)
- return = pure
-
-instance Applicative (CmdLineP s) where
- pure x = CmdLineP (pure x)
- (<*>) = ap
-
-getCmdLineState :: CmdLineP s s
-getCmdLineState = CmdLineP State.get
-
-putCmdLineState :: s -> CmdLineP s ()
-putCmdLineState x = CmdLineP (State.put x)
-
-runCmdLineP :: CmdLineP s a -> s -> (a, s)
-runCmdLineP (CmdLineP k) s0 = runIdentity $ runStateT k s0
+parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamicTrie False
-- | A helper to parse a set of flags from a list of command-line arguments, handling
-- response files.
processCmdLineP
:: forall s m. MonadIO m
- => [Flag (CmdLineP s)] -- ^ valid flags to match against
+ => FlagSpecTrie s -- ^ valid flags to match against
-> s -- ^ current state
-> [Located String] -- ^ arguments to parse
-> m (([Located String], [Err], [Warn]), s)
-- ^ (leftovers, errors, warnings)
processCmdLineP activeFlags s0 args =
- runStateT (processArgs (map (hoistFlag getCmdLineP) activeFlags) args parseResponseFile) s0
- where
- getCmdLineP :: CmdLineP s a -> StateT s m a
- getCmdLineP (CmdLineP k) = k
+ runStateT (processArgs activeFlags args parseResponseFile) s0
-- | Parses the dynamically set flags for GHC. This is the most general form of
-- the dynamic flag parser that the other methods simply wrap. It allows
@@ -890,7 +898,7 @@ processCmdLineP activeFlags s0 args =
-- arguments from the command line or from a file pragma.
parseDynamicFlagsFull
:: forall m. MonadIO m
- => [Flag (CmdLineP DynFlags)] -- ^ valid flags to match against
+ => FlagSpecTrie DynFlags -- ^ valid flags to match against
-> Bool -- ^ are the arguments from the command line?
-> Logger -- ^ logger
-> DynFlags -- ^ current dynamic flags
@@ -1012,14 +1020,22 @@ allFlagsDeps keepDeprecated = [ '-':flagName flag
flagsAll :: [Flag (CmdLineP DynFlags)]
flagsAll = map snd flagsAllDeps
+-- | Same as 'flagsAll' but in trie form for fast lookup.
+--
+-- See Note [Optimising the processing of command-line arguments]
+flagsAllTrie :: FlagSpecTrie DynFlags
+flagsAllTrie = extendFlagSpecTrie flagsDynamicTrie $ map snd package_flags_deps
+
-- All dynamic flags present in GHC with deprecation information.
flagsAllDeps :: [(Deprecation, Flag (CmdLineP DynFlags))]
flagsAllDeps = package_flags_deps ++ dynamic_flags_deps
-- All dynamic flags, minus package flags, present in GHC.
-flagsDynamic :: [Flag (CmdLineP DynFlags)]
-flagsDynamic = map snd dynamic_flags_deps
+--
+-- See Note [Optimising the processing of command-line arguments].
+flagsDynamicTrie :: FlagSpecTrie DynFlags
+flagsDynamicTrie = mkFlagSpecTrie $ map snd dynamic_flags_deps
-- ALl package flags present in GHC.
flagsPackage :: [Flag (CmdLineP DynFlags)]
@@ -2013,8 +2029,7 @@ dynamic_flags_deps = [
++
------ Warning flags -------------------------------------------------
- [ make_ord_flag defFlag "W" (NoArg (setWarningGroup W_extra))
- , make_ord_flag defFlag "Werror"
+ [ make_ord_flag defFlag "Werror"
(NoArg (do { setGeneralFlag Opt_WarnIsError
; setFatalWarningGroup W_everything }))
, make_ord_flag defFlag "Wwarn"
@@ -2040,7 +2055,7 @@ dynamic_flags_deps = [
, (NotDeprecated, customOrUnrecognisedWarning "Werror=" setCustomWErrorFlag)
, (NotDeprecated, customOrUnrecognisedWarning "Wwarn=" unSetCustomFatalWarningFlag)
, (NotDeprecated, customOrUnrecognisedWarning "Wno-error=" unSetCustomFatalWarningFlag)
- , (NotDeprecated, customOrUnrecognisedWarning "W" setCustomWarningFlag)
+ , flagW
, (Deprecated, customOrUnrecognisedWarning "fwarn-" setCustomWarningFlag)
, (Deprecated, customOrUnrecognisedWarning "fno-warn-" unSetCustomWarningFlag)
]
@@ -2076,19 +2091,35 @@ warningControls set unset set_werror unset_fatal xs =
++ map (mkFlag turnOn "fwarn-" set . hideFlag) xs
++ map (mkFlag turnOff "fno-warn-" unset . hideFlag) xs
+-- | The "W" flag is special in that it can mean enable extra warnings ('W_extra')
+-- or enable a custom warning, if the suffix is non-empty.
+flagW :: (Deprecation, Flag (CmdLineP DynFlags))
+flagW =
+ make_ord_flag defFlag "W" $ OptPrefix $ \suffix ->
+ if null suffix then do
+ -- Reject "-W=" instead of taking it to mean "-W".
+ arg <- getArg
+ if arg == "-W" then
+ setWarningGroup W_extra
+ else
+ addErr ("missing argument for flag: " ++ arg)
+ else
+ customOrUnrecognisedWarningAction "W" setCustomWarningFlag suffix
+
-- | This is where we handle unrecognised warning flags. If the flag is valid as
-- an extended warning category, we call the supplied action. Otherwise, issue a
-- warning if -Wunrecognised-warning-flags is set. See #11429 for context.
-- See Note [Warning categories] in GHC.Unit.Module.Warnings.
customOrUnrecognisedWarning :: String -> (WarningCategory -> DynP ()) -> Flag (CmdLineP DynFlags)
-customOrUnrecognisedWarning prefix custom = defHiddenFlag prefix (Prefix action)
- where
- action :: String -> DynP ()
- action flag
+customOrUnrecognisedWarning prefix custom =
+ defHiddenFlag prefix $ Prefix $ customOrUnrecognisedWarningAction prefix custom
+
+customOrUnrecognisedWarningAction :: String -> (WarningCategory -> DynP ()) -> String -> DynP ()
+customOrUnrecognisedWarningAction prefix custom flag
| validWarningCategory cat = custom cat
| otherwise = unrecognised flag
- where
- cat = mkWarningCategory (packHText flag)
+ where
+ cat = mkWarningCategory (packHText flag)
unrecognised flag = do
-- #23402 and #12056
=====================================
compiler/ghc.cabal.in
=====================================
@@ -474,6 +474,7 @@ Library
GHC.Data.Stream
GHC.Data.Strict
GHC.Data.StringBuffer
+ GHC.Data.StringTrie
GHC.Data.TrieMap
GHC.Data.Unboxed
GHC.Data.UnionFind
=====================================
ghc/GHC/Driver/Session/Mode.hs
=====================================
@@ -180,7 +180,7 @@ parseModeFlags :: [Located String]
[Warn])
parseModeFlags args = do
((leftover, errs1, warns), (mModeFlag, units, errs2, flags')) <-
- processCmdLineP mode_flags (Nothing, [], [], []) args
+ processCmdLineP mode_flags_trie (Nothing, [], [], []) args
let mode = case mModeFlag of
Nothing -> doMakeMode
Just (m, _) -> m
@@ -191,10 +191,14 @@ parseModeFlags args = do
return (mode, units, flags' ++ leftover, warns)
-type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
+type ModeMS = (Maybe (Mode, String), [String], [String], [Located String])
+type ModeM = CmdLineP ModeMS
-- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
-- so we collect the new ones and return them.
+mode_flags_trie :: FlagSpecTrie ModeMS
+mode_flags_trie = mkFlagSpecTrie mode_flags
+
mode_flags :: [Flag ModeM]
mode_flags =
[ ------- help / version ----------------------------------------------
=====================================
testsuite/tests/MiniQuickCheck.hs
=====================================
@@ -28,6 +28,7 @@ module MiniQuickCheck
, propertyCompare
, propertyAnd
, propertyTrue
+ , propertyEqWithContext
, getCheck
-- * QuickCheck test tree
@@ -51,11 +52,15 @@ module MiniQuickCheck
, nonZero
, BoundedShiftAmount(..)
, BoundedBy(..)
+ , BoundedList(..)
+ , BoundedChar(..)
) where
-- base
import Control.Exception
( SomeException, displayException, evaluate, try )
+import Control.Monad
+ ( replicateM )
import Control.Monad.IO.Class
( liftIO )
import Data.Bits
@@ -64,8 +69,6 @@ import Data.Bits
)
import Data.Int
( Int8, Int16, Int32, Int64 )
-import Data.IORef
- ( newIORef, atomicModifyIORef' )
import Data.Kind
( Type )
import Data.List
@@ -84,6 +87,8 @@ import System.Exit
( die, exitFailure )
import Text.Read
( readMaybe )
+import System.IO.Unsafe
+ ( unsafePerformIO )
-- transformers
import Control.Monad.Trans.Reader
@@ -141,6 +146,15 @@ propertyCompare s f a b = PropertyBinaryOp (f a b) s (show a) (show b)
(===) = propertyCompare "==" (==)
infix 4 ===
+-- | Prints the given message when the two values are not equal.
+propertyEqWithContext :: (Eq a, Show a) => String -> a -> a -> PropertyCheck
+propertyEqWithContext msg =
+ propertyCompare
+ (intercalate "\n" $
+ "is not the expected" : map (" " ++) (lines msg ++ ["expected:"])
+ )
+ (==)
+
-- | Conjunction of two property checks.
propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck
propertyAnd = PropertyAnd
@@ -424,3 +438,28 @@ instance
where
n :: a
n = fromIntegral $ natVal @n Proxy
+
+type BoundedList :: Nat -> Type -> Type
+newtype BoundedList n a = BoundedList { getBoundedList :: [a] }
+ deriving (Eq, Ord, Show)
+
+instance
+ forall n a
+ . ( KnownNat n, Arbitrary a )
+ => Arbitrary ( BoundedList n a ) where
+ arbitrary = do
+ x <- arbitrary
+ let n = (x :: Word64) `mod` fromIntegral (natVal @n Proxy + 1)
+ BoundedList <$> replicateM (fromIntegral n) arbitrary
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
+ arbitrary = (,) <$> arbitrary <*> arbitrary
+
+type BoundedChar :: Nat -> Type
+newtype BoundedChar n = BoundedChar { getBoundedChar :: Char }
+ deriving (Eq, Ord, Show)
+
+instance KnownNat n => Arbitrary (BoundedChar n) where
+ arbitrary = do
+ x <- getBoundedBy @_ @n <$> arbitrary
+ pure $ BoundedChar (['a'..] !! abs x)
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -99,6 +99,8 @@ test('driver200', [extra_files(['A200.hs', 'B200/', 'D200.hs'])], makefile_test,
test('T2566', normalise_fun(normalise_errmsg), makefile_test, [])
+test('stringtrie', [mini_quickcheck], compile_and_run, ['-package ghc'])
+
test('pragma001', normal, compile, [''])
test('pragma002', normal, compile, [''])
=====================================
testsuite/tests/driver/stringtrie.hs
=====================================
@@ -0,0 +1,79 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+import Data.Bifunctor (first)
+import Data.Coerce
+import Data.Function (on)
+import Data.List (nubBy, sortOn, stripPrefix)
+import GHC.Data.StringTrie as StringTrie
+import MiniQuickCheck
+
+main :: IO ()
+main = do
+ runTestsMain (Iterations 1000) tests
+ -- runTests (Iterations 100) 9856592474076851907 tests
+
+tests :: Test
+tests = Group "StringTrie"
+ [ Property "lookup_after_insert" prop_lookup_after_insert
+ , Property "fromList == foldl (flip $ uncurry insert) empty" prop_fromList_foldl
+ ]
+
+type BString4 = BoundedList 4 (BoundedChar 4)
+
+-- | @lookup qs (insert k v t)@ returns the values of matching keys ordered by
+-- suffix length.
+prop_lookup_after_insert
+ -- | query string as a bounded list
+ :: BoundedList 6 (BoundedChar 3)
+ -- | length of the key to insert in @t@
+ -> BoundedBy Int 3
+ -- | value to insert in @t@
+ -> BoundedBy Int 9
+ -- | list of key-value pairs to build the trie @t@
+ -> BoundedList 6 (BString4, Int `BoundedBy` 9)
+ -> PropertyCheck
+prop_lookup_after_insert bqs i0 v0 bkvs =
+ let kvs = coerce bkvs :: [(String, Int)]
+ t = fromList kvs
+ qs = coerce @_ @String bqs
+ i = min (abs (getBoundedBy i0)) (length qs)
+ k = take i qs
+ v = getBoundedBy v0
+ -- (v1, sfx1) pairs where (k1, v1) is in t and k1 is a prefix of qs
+ expected =
+ [ (v1, sfx1)
+ | kv@(k1, v1) <- nubBy ((==) `on` fst) $ (k, v) : reverse kvs
+ , Just sfx1 <- [stripPrefix k1 qs]
+ ]
+ in
+ propertyEqWithContext
+ (unlines
+ [ "k = " ++ show k
+ , "v = " ++ show v
+ , "qs = " ++ show qs
+ , "kvs = " ++ show kvs
+ ]
+ )
+ (StringTrie.lookup qs (insert k v t))
+ (sortOn (length . snd) expected)
+
+-- | @fromList xs == foldl (flip $ uncurry insert) empty xs@
+prop_fromList_foldl
+ -- | list of key-value pairs to build the trie @t@
+ :: Int `BoundedBy` 7
+ -> BoundedList 6 (BString4, Int `BoundedBy` 9)
+ -> PropertyCheck
+prop_fromList_foldl (BoundedBy sparseness) bkvs =
+ let kvs = map (first shiftString) $ coerce bkvs :: [(String, Int)]
+ in propertyEqWithContext
+ (unlines ["kvs = " ++ show kvs])
+ (fromListWithSparseness (sparseness - 1) kvs)
+ (foldl (flip $ uncurry insert) empty kvs)
+ where
+ -- Bring characters next to the end of the ASCII range to test the
+ -- array-based implementation of fromList.
+ shiftString = map shiftChar
+ shiftChar = charPlus (126 - fromEnum 'a')
+ charPlus x c = toEnum (x + fromEnum c)
=====================================
testsuite/tests/driver/stringtrie.stdout
=====================================
@@ -0,0 +1,5 @@
+Group StringTrie
+ Running lookup_after_insert
+ Passed 1000 iterations
+ Running fromList == foldl (flip $ uncurry insert) empty
+ Passed 1000 iterations
=====================================
testsuite/tests/perf/compiler/T25763.stderr
=====================================
@@ -0,0 +1 @@
+[1 of 1] Compiling Main ( t25763.hs, nothing )
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -874,6 +874,16 @@ test ('T24984',
compile,
['-O'])
+# Performance regression test for the parser of command line arguments
+test(
+ 'T25763',
+ [
+ collect_compiler_runtime(5),
+ pre_cmd(f'seq 400000 | sed "s/.*/-XCPP/" > t25763.txt && echo "main = pure ()" > t25763.hs'),
+ ],
+ multimod_compile,
+ ['t25763', '@t25763.txt -c -fno-code'])
+
test('interpreter_steplocal',
[ collect_compiler_stats('bytes allocated', 5)
],
=====================================
testsuite/tests/warnings/should_fail/WExpectedNoArgError.stderr
=====================================
@@ -0,0 +1,2 @@
+ghc: on the commandline: missing argument for flag: -W=
+Usage: For basic information, try the `--help' option.
=====================================
testsuite/tests/warnings/should_fail/all.T
=====================================
@@ -15,6 +15,7 @@ test('CaretDiagnostics1',
[normalise_whitespace_fun(normalise_whitespace_carefully)],
compile_fail,
['-fdiagnostics-show-caret -ferror-spans'])
+test('WExpectedNoArgError', normal, compile_fail, ['-W='])
test('CaretDiagnostics2', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('Colour', normal, compile_fail, ['-fdiagnostics-color=always'])
test('T20263', normal, compile_fail, ['-Wunicode-bidirectional-format-characters -Werror'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66ab9cb9471626c1292efadd2c8c35…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66ab9cb9471626c1292efadd2c8c35…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/davide/io_manager_tests] 2 commits: testsuite: Fix python type errors
by David Eichmann (＠DavidEichmann) 22 Sep '26
by David Eichmann (＠DavidEichmann) 22 Sep '26
22 Sep '26
David Eichmann pushed to branch wip/davide/io_manager_tests at Glasgow Haskell Compiler / GHC
Commits:
6c95a779 by David Eichmann at 2026-09-22T11:14:52+01:00
testsuite: Fix python type errors
- - - - -
1555161e by David Eichmann at 2026-09-22T11:15:05+01:00
Add test modifier to test over all IO Managers
- - - - -
7 changed files:
- + changelog.d/testsuite_io_managers.md
- testsuite/config/ghc
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/rts/all.T
Changes:
=====================================
changelog.d/testsuite_io_managers.md
=====================================
@@ -0,0 +1,7 @@
+section: packaging
+issues:
+mrs: !16704
+synopsis:
+ Tests may now use modifiers `io_managers`/`all_available_io_managers`/`all_available_io_managers_except` to extend test cases over all or some IO Managers.
+description:
+ Test cases are generated as normal given other modifiers but now each is further split into different IO Managers. Note that IO Managers availablility depends on threaded/non-threaded RTS and OS. Even when using `all_available_io_managers`, the test author must still ensure that a `threaded` way is used if threaded IO Managers are to be tested e.g. by using extra_ways(['threaded2]).
=====================================
testsuite/config/ghc
=====================================
@@ -257,6 +257,8 @@ def get_compiler_info():
)
except Exception as err:
+ # We don't throw so that we can still discover tests before we've built
+ # GHC (i.e. config.compiler doesn't yet exist).
print("Exception thrown in testsuite/config/ghc.get_compiler_info: %s", err)
else:
@@ -315,6 +317,61 @@ def get_compiler_info():
config.ghc_th_way = "normal"
config.ghc_th_hi_ext = "hi"
+ # I/O manager discovery.
+ #
+ # Which I/O managers (GHC's `--io-manager` RTS flag) a given RTS build
+ # supports depends on the target platform and on whether the RTS is the
+ # threaded or non-threaded flavour (see rts/IOManager.h's
+ # IOMGR_ENABLED_* macros). Rather than duplicate that platform/way
+ # dependent logic here, we ask the RTS itself: giving it a bogus
+ # '--io-manager=' choice makes it print, on stderr, the list of I/O
+ # managers it was actually built to support (see IOManager.h's
+ # IOMGRS_ENABLED_STR, used when reporting the error in RtsFlags.c),
+ # which we then parse out.
+ def discover_io_managers_generic(extra_flags):
+ import tempfile
+
+ test_src = 'main :: IO ()\nmain = return ()\n'
+
+ res = [None]
+
+ with tempfile.TemporaryDirectory() as d:
+ src = Path(d) / 'IOMgrProbe.hs'
+ src.write_text(test_src)
+ exe = Path(d) / ('IoMgrProbe' + config.exeext)
+
+ # -rtsopts is needed so that the resulting binary will even
+ # consider an --io-manager= flag (rather than immediately
+ # rejecting all "unsafe" RTS options).
+ cmd = '{} -v0 -rtsopts -o {} {} {}'.format(
+ config.compiler,
+ exe,
+ src,
+ ' '.join(extra_flags))
+ try:
+ cp = subprocess.run(
+ cmd,
+ shell=True,
+ cwd=d,
+ stdout=subprocess.DEVNULL,
+ stderr=None if config.verbose >= 3 else subprocess.DEVNULL)
+ if cp.returncode != 0 or not exe.exists():
+ raise Exception("Error in testsuite/config/ghc.discover_io_managers: failed to compile with: {}".format(cmd))
+ res = list(discover_io_managers(exe, d))
+
+ except Exception as err:
+ # We don't throw so that we can still discover tests before we've built
+ # GHC (i.e. config.compiler doesn't yet exist).
+ print("Exception thrown in testsuite/config/ghc.discover_io_managers_generic: %s", err)
+
+ return res
+
+ config.io_managers_nonthreaded = discover_io_managers_generic([])
+ config.io_managers_threaded = (
+ discover_io_managers_generic(['-threaded']) if config.ghc_with_threaded_rts
+ else [])
+ config.io_managers_all = list(set(config.io_managers_nonthreaded).union(set(config.io_managers_threaded)))
+
config.cmm_cpp_is_gcc = test_compile(
['-c'],
test_filename='test.cmm',
=====================================
testsuite/driver/runtests.py
=====================================
@@ -28,7 +28,7 @@ import subprocess
import asyncio
-from testutil import getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
+from testutil import discover_io_managers, getStdout, str_warn, str_info, print_table, shorten_metric_name, str_removeprefix
from testglobals import getConfig, ghc_env, TestConfig, t, \
TestOptions, brokens, PerfMetric
from my_typing import TestName
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -126,6 +126,15 @@ class TestConfig:
self.way_flags = {} # type: Dict[WayName, List[str]]
self.way_rts_flags = {} # type: Dict[WayName, List[str]]
+ # I/O managers (GHC's `--io-manager` RTS flag) supported by the threaded runtime.
+ self.io_managers_threaded = [] # type: List[str]
+
+ # I/O managers (GHC's `--io-manager` RTS flag) supported by the non-threaded runtime.
+ self.io_managers_nonthreaded = [] # type: List[str]
+
+ # All I/O managers (GHC's `--io-manager` RTS flag)
+ self.io_managers_all = [] # type: List[str]
+
# Do we have a functional LLVM toolchain?
self.have_llvm = False
@@ -227,7 +236,7 @@ class TestConfig:
self.allowed_perf_changes = {}
# The test environment.
- self.test_env = 'local'
+ self.test_env = TestEnv('local')
# terminal supports colors
self.supports_colors = False
@@ -366,6 +375,11 @@ class TestOptions:
# add these ways to the default set
self.extra_ways = [] # type: List[WayName]
+ # IO Managers to test
+ # * None - only default IO Manager
+ # * [...] - list of io managers e.g. "mio" or "poll"
+ self.io_managers = [None] # type: List[str|None]
+
# the result we normally expect for this test
self.expect = 'pass'
=====================================
testsuite/driver/testlib.py
=====================================
@@ -23,7 +23,7 @@ import subprocess
from testglobals import config, ghc_env, default_testopts, brokens, t, \
TestRun, TestResult, TestOptions, PerfMetric
-from testutil import strip_quotes, lndir, link_or_copy_file, passed, \
+from testutil import discover_io_managers, strip_quotes, lndir, link_or_copy_file, passed, \
failBecause, residency_testing_metrics, \
stable_perf_counters, \
PassFail, badResult, str_warn, str_removeprefix
@@ -190,7 +190,7 @@ def no_lint( name, opts ):
def stage1(name, opts):
# See Note [Why is there no stage1 setup function?]
- framework_fail(name, 'stage1 setup function does not exist',
+ framework_fail(name, None,
'add your test to testsuite/tests/stage1 instead')
# Note [Why is there no stage1 setup function?]
@@ -341,7 +341,7 @@ def req_th( name, opts ):
req_interp(name, opts);
if ghc_dynamic():
- return _omit_ways(name, opts, ['profasm', 'profthreaded'])
+ return _omit_ways(name, opts, [WayName('profasm'), WayName('profthreaded')])
def req_plugins( name, opts ):
"""
@@ -355,7 +355,7 @@ def req_plugins( name, opts ):
req_interp(name, opts)
# Plugins aren't supported with the external interpreter (#14335)
- expect_broken_for(14335,['ext-interp'])(name,opts)
+ expect_broken_for(IssueNumber(14335),[WayName('ext-interp')])(name,opts)
if config.cross:
opts.skip = True
@@ -569,6 +569,33 @@ def extra_ways( ways: List[WayName] ):
return helper
+# -----
+
+def _io_managers( name: TestName, opts, io_mgrs: List[str] ) -> None:
+ opts.io_managers = io_mgrs
+
+def io_managers( io_mgrs: List[str] ):
+ """
+ Run this test once for each of the given I/O managers (identified by
+ the name used with GHC's `--io-manager` RTS flag, e.g. 'mio',
+ 'select', 'winio'), instead of the usual set of ways. I/O managers
+ that are not supported on the current platform/build are silently
+ skipped.
+ """
+ return lambda name, opts: _io_managers(name, opts, io_mgrs)
+
+def all_available_io_managers( name: TestName, opts ):
+ """
+ Run this test once for each I/O manager supported by this
+ platform/build.
+ """
+ _io_managers(name, opts, config.io_managers_all)
+
+def all_available_io_managers_except(exclude: List[str]):
+ """
+ Like all_available_io_managers, but excluding the given I/O managers.
+ """
+ return lambda name, opts: _io_managers(name, opts, list(set(config.io_managers_all) - set(exclude)))
# -----
@@ -661,18 +688,15 @@ def collect_size ( deviation, path ):
def collect_size_func ( deviation, path_func ):
return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path_func())) )
-def get_dir_size(path):
+def get_dir_size(path) -> int:
total = 0
- try:
- with os.scandir(path) as it:
- for entry in it:
- if entry.is_file():
- total += entry.stat().st_size
- elif entry.is_dir():
- total += get_dir_size(entry.path)
- return total
- except FileNotFoundError:
- print("Exception: Could not find: " + path)
+ with os.scandir(path) as it:
+ for entry in it:
+ if entry.is_file():
+ total += entry.stat().st_size
+ elif entry.is_dir():
+ total += get_dir_size(entry.path)
+ return total
def collect_size_dir ( deviation, path ):
return collect_size_dir_func ( deviation, lambda: path )
@@ -790,7 +814,7 @@ def find_non_inplace_so(lib):
return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),False)
-def collect_generic_stat ( metric, deviation: Optional[int], get_stat: Callable[[WayName], str]):
+def collect_generic_stat ( metric, deviation: Optional[int], get_stat: Callable[[WayName], Any]):
"""
Define a generic stat test, which computes the statistic by calling the function
given as the third argument.
@@ -1135,7 +1159,7 @@ def _collect_compiler_perf_counters(counters: Set[str], deviation: Optional[int]
# Slightly hacky, we need the requested perf_counters in 'simple_run'.
# Thus, we have to globally register these counters
opts.compiler_perf_counters += list(counters)
- _collect_stats(name, opts, counters, deviation, False, True, True)
+ _collect_stats(name, opts, counters, deviation, None, True, True)
return f
@@ -1334,21 +1358,22 @@ def check_errmsg(needle):
# grep_errmsg(regex,[groups])
# If groups are given, return only the matched groups
# that matches the regex.
-def grep_errmsg_norm(needle:str, groups = None):
+def grep_errmsg_norm(needle:str, groups_may = None):
- def get_match(str:str):
- m = re.search(needle,str)
- if m:
- return "".join([m.group(g) for g in groups if m.group(g) is not None])
- else:
- return None
-
- def norm(str) -> str:
- if groups == None:
+ def norm(string) -> str:
+ if groups_may == None:
return "".join( filter(lambda l: re.search(needle,l),
- str.splitlines(True)))
+ string.splitlines(True)))
else:
- matches = [get_match(x) for x in str.splitlines(True)]
+ groups = groups_may
+ def get_match(string: str):
+ m = re.search(needle, string)
+ if m:
+ return "".join([m.group(g) for g in groups if m.group(g) is not None])
+ else:
+ return None
+
+ matches = [get_match(x) for x in string.splitlines(True)]
res = "\n".join([x for x in matches if x])
return res
return norm
@@ -1573,6 +1598,12 @@ do_not_copy = ('.hi', '.o', '.dyn_hi'
, '.dyn_o', '.out'
,'.hi-boot', '.o-boot') # 12112
+def way_supports_io_manager(way: WayName, io_manager: None | str) -> bool:
+ if not io_manager:
+ return True
+ way_is_threaded = '-threaded' in config.way_flags[way]
+ return io_manager in config.io_managers_threaded if way_is_threaded else io_manager in config.io_managers_nonthreaded
+
async def test_common_work(name: TestName, opts,
func, args) -> None:
try:
@@ -1621,7 +1652,20 @@ async def test_common_work(name: TestName, opts,
# A test itself can request extra ways by setting opts.extra_ways
all_ways = list(OrderedDict.fromkeys(all_ways + [way for way in opts.extra_ways if way not in all_ways]))
- t.total_test_cases += len(all_ways)
+ # We run each way over each io manager (or just None meaning the default IO Manager)
+ all_ways_and_io_managers = dict(
+ (
+ way,
+ [io_manager
+ for io_manager in opts.io_managers
+ if way_supports_io_manager(way, io_manager)
+ ]
+ )
+ for way in all_ways
+ )
+
+ for io_managers in all_ways_and_io_managers.values():
+ t.total_test_cases += len(io_managers)
only_ways = getTestOpts().only_ways
ok_way = lambda way: \
@@ -1704,17 +1748,26 @@ async def test_common_work(name: TestName, opts,
# Run the required tests...
for way in do_ways:
- if stopping():
- break
- try:
- await do_test(name, way, func, args, files)
- except KeyboardInterrupt:
- stopNow()
- except Exception as e:
- traceback.print_exc()
- framework_fail(name, way, traceback.format_exc())
+ for io_manager in all_ways_and_io_managers[way]:
+ if stopping():
+ break
+ try:
+ await do_test(
+ name,
+ way,
+ io_manager,
+ func,
+ args,
+ files)
+ except KeyboardInterrupt:
+ stopNow()
+ except Exception as e:
+ traceback.print_exc()
+ framework_fail(name, way, traceback.format_exc())
+
+ for skipped_way in set(all_ways) - set(do_ways):
+ t.n_tests_skipped += len(all_ways_and_io_managers[skipped_way])
- t.n_tests_skipped += len(set(all_ways) - set(do_ways))
if getTestOpts().expect == 'missing-lib': t.n_missing_libs += 1
if config.cleanup and do_ways:
@@ -1733,6 +1786,7 @@ async def test_common_work(name: TestName, opts,
async def do_test(name: TestName,
way: WayName,
+ io_manager: None | str,
func: Callable[..., Awaitable[PassFail]],
args,
files: Set[str]
@@ -1740,6 +1794,8 @@ async def do_test(name: TestName,
opts = getTestOpts()
full_name = name + '(' + way + ')'
+ if io_manager:
+ full_name += ' (IO Manager: {})'.format(io_manager)
test_n = len(allTestNames)
progress_args = [ full_name, t.total_tests, test_n,
[len(t.unexpected_passes),
@@ -1820,7 +1876,20 @@ async def do_test(name: TestName,
# Don't continue and try to run the test if the pre_cmd fails.
return
- result = await func(*[name,way] + args)
+
+ func_has_io_manager_param = func in [
+ backpack_run,
+ compile_and_run,
+ ghci_multiunit_script,
+ ghci_script,
+ multi_compile_and_run,
+ multimod_compile_and_run,
+ warn_and_run
+ ]
+
+ io_manager_arg = [io_manager] if func_has_io_manager_param else []
+
+ result = await func(*[name,way] + io_manager_arg + args)
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
@@ -1909,7 +1978,7 @@ def framework_warn(name: TestName, way: WayName, reason: str) -> None:
# run_command.
async def run_command( name, way, cmd ):
- return await simple_run( name, '', override_options(cmd), '' )
+ return await simple_run( name, WayName(''), None, override_options(cmd), '' )
async def makefile_test( name, way, target=None ):
if target is None:
@@ -1921,7 +1990,7 @@ async def makefile_test( name, way, target=None ):
# -----------------------------------------------------------------------------
# GHCi tests
-async def ghci_script( name, way, script):
+async def ghci_script( name, way, io_manager, script):
flags = ' '.join(get_compiler_flags())
way_flags = ' '.join(config.way_flags[way])
@@ -1932,9 +2001,9 @@ async def ghci_script( name, way, script):
# NB: put way_flags before flags so that flags in all.T can override others
getTestOpts().stdin = script
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
-async def ghci_multiunit_script( name, way, units, script):
+async def ghci_multiunit_script( name, way, io_manager, units, script):
flags = ' '.join(get_compiler_flags())
way_flags = ' '.join(config.way_flags[way])
unit_flags = ' '.join(['-unit @%s' % unit for unit in units])
@@ -1946,7 +2015,7 @@ async def ghci_multiunit_script( name, way, units, script):
# NB: put way_flags before flags so that flags in all.T can override others
getTestOpts().stdin = script
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
# -----------------------------------------------------------------------------
# Compile-only tests
@@ -1995,7 +2064,7 @@ async def multi_compile_fail( name, way, top_mod, extra_mods, extra_hc_opts ):
return await do_compile( name, way, True, top_mod, extra_mods, [], extra_hc_opts)
async def make_depend( name, way, mods, extra_hc_opts ):
- return await do_compile( name, way, False, ' '.join(mods), [], [], extra_hc_opts, mode = '-M')
+ return await do_compile( name, way, False, Path(' '.join(mods)), [], [], extra_hc_opts, mode = '-M')
async def do_compile(name: TestName,
way: WayName,
@@ -2126,7 +2195,8 @@ async def compile_grep_core(name: TestName,
async def compile_and_run__(name: TestName,
way: WayName,
- top_mod: Path,
+ io_manager: None | str,
+ top_mod: Path | None,
extra_mods: List[str],
extra_hc_opts: str,
backpack: bool=False,
@@ -2168,22 +2238,22 @@ async def compile_and_run__(name: TestName,
cmd = './' + name + extension
# we don't check the compiler's stderr for a compile-and-run test
- return await simple_run( name, way, cmd, getTestOpts().extra_run_opts )
+ return await simple_run( name, way, io_manager, cmd, getTestOpts().extra_run_opts )
-async def compile_and_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts)
+async def compile_and_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts)
-async def backpack_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts, backpack=True )
+async def backpack_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts, backpack=True )
-async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ):
- return await compile_and_run__( name, way, top_mod, [], extra_hc_opts)
+async def multimod_compile_and_run( name, way, io_manager, top_mod, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, top_mod, [], extra_hc_opts)
-async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ):
- return await compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts)
+async def multi_compile_and_run( name, way, io_manager, top_mod, extra_mods, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, top_mod, extra_mods, extra_hc_opts)
-async def warn_and_run( name, way, extra_hc_opts ):
- return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True)
+async def warn_and_run( name, way, io_manager, extra_hc_opts ):
+ return await compile_and_run__( name, way, io_manager, None, [], extra_hc_opts, compile_stderr = True)
async def static_stats( name, way ):
opts = getTestOpts()
@@ -2390,7 +2460,7 @@ async def simple_build(name: Union[TestName, str],
# from /dev/null. Route output to testname.run.stdout and
# testname.run.stderr. Returns the exit code of the run.
-async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: str) -> Any:
+async def simple_run(name: TestName, way: WayName, io_manager: None | str, prog: str, extra_run_opts: str) -> Any:
opts = getTestOpts()
# figure out what to use for stdin
@@ -2409,6 +2479,9 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
my_rts_flags = rts_flags(way)
+ if io_manager:
+ my_rts_flags += ' +RTS --io-manager={0} -RTS '.format(io_manager)
+
# Collect runtime stats if necessary:
# isStatsTest and not isCompilerStatsTest():
# assume we are running a ghc compiled program. Collect stats.
@@ -2434,6 +2507,12 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
output_file = perfStatsFile(False, name)
+ # Check that IO Manager is available
+ if io_manager:
+ available_io_managers = discover_io_managers(prog, opts.testdir)
+ if io_manager not in available_io_managers:
+ framework_fail(name, way, 'IO Manager {} unexpectedly unavailable (available IO Managers: {}). `-non-threaded`/`-threaded` is only supported through way RTS flags (not manually added via test modifiers/args) when testing over IO Managers.'.format(io_manager, available_io_managers))
+
# run the command
exit_code = await runCmdPerf(opts.compiler_perf_counters, cmd, output_file,
working_dir=opts.testdir,
@@ -2495,7 +2574,7 @@ def rts_flags(way: WayName) -> str:
async def interpreter_run(name: TestName,
way: WayName,
extra_hc_opts: str,
- top_mod: Path
+ top_mod: Path | None
) -> PassFail:
opts = getTestOpts()
@@ -2866,11 +2945,11 @@ async def compare_outputs(
if config.accept_platform:
if_verbose(1, 'Accepting new output for platform "'
+ config.platform + '".')
- expected_path += '-' + config.platform
+ expected_path = Path(str(expected_path) + '-' + config.platform)
elif config.accept_os:
if_verbose(1, 'Accepting new output for os "'
+ config.os + '".')
- expected_path += '-' + config.os
+ expected_path = Path(str(expected_path) + '-' + config.os)
else:
if_verbose(1, 'Accepting new output.')
@@ -3500,7 +3579,7 @@ def find_expected_file(name: TestName, suff: str, way: WayName) -> Path:
for f in files:
if in_srcdir(f).exists():
- return f
+ return Path(f)
return basename
=====================================
testsuite/driver/testutil.py
=====================================
@@ -1,4 +1,5 @@
import os
+import re
import subprocess
import shutil
import tempfile
@@ -179,3 +180,21 @@ def shorten_metric_name(name: str) -> str:
"binary_size/if_compression(3)": "size/3",
}
return dic.get(name, name)
+
+# I/O manager discovery for a haskell binary. Returns the set of IO Manager
+# strings supported by the binary
+def discover_io_managers(hs_exe: str | Path, cwd: str | Path) -> Set[str]:
+ rp = subprocess.run(
+ [str(hs_exe), '+RTS', '--io-manager=not-a-real-io-manager', '-RTS'],
+ cwd=cwd,
+ stdout=subprocess.DEVNULL,
+ stderr=subprocess.PIPE)
+ stderr = rp.stderr.decode('utf-8', errors='replace')
+
+ m = re.search(r'choices are:\s*(.*)', stderr)
+ if not m:
+ raise Exception("Expected stderr output of form 'choices are: ...' but got: {}".format(stderr))
+
+ # 'auto' is a meta-choice (let the RTS pick a default for us), not
+ # an I/O manager implementation in its own right.
+ return set(m.group(1).split()) - {'auto'}
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -662,8 +662,9 @@ test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142'
test('T23400', [], compile_and_run, ['-with-rtsopts -A8k'])
test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), skip),
- pre_cmd('$MAKE -s --no-print-directory IOManager.hs')],
- compile_and_run, [''])
+ pre_cmd('$MAKE -s --no-print-directory IOManager.hs'),
+ extra_ways(['threaded2']), all_available_io_managers_except('winio')],
+ compile_and_run, [''])
test('T24142', [req_target_smp], compile_and_run, ['-threaded -with-rtsopts "-N2"'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38c25628d99913e45dc7764fb2feaf…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38c25628d99913e45dc7764fb2feaf…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0