[Git][ghc/ghc][master] 2 commits: llvmGen: Fix built-in variable predicate
by Marge Bot (＠marge-bot) 08 May '25
by Marge Bot (＠marge-bot) 08 May '25
08 May '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6e67fa08 by Ben Gamari at 2025-05-08T06:21:21-04:00
llvmGen: Fix built-in variable predicate
Previously the predicate to identify LLVM builtin global variables was
checking for `$llvm` rather than `@llvm` as it should.
- - - - -
a9d0a22c by Ben Gamari at 2025-05-08T06:21:22-04:00
llvmGen: Fix linkage of built-in arrays
LLVM now insists that built-in arrays use Appending linkage, not
Internal.
Fixes #25769.
- - - - -
2 changed files:
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Data.hs
Changes:
=====================================
compiler/GHC/CmmToLlvm/Base.hs
=====================================
@@ -526,10 +526,10 @@ generateExternDecls = do
modifyEnv $ \env -> env { envAliases = emptyUniqSet }
return (concat defss, [])
--- | Is a variable one of the special @$llvm@ globals?
+-- | Is a variable one of the special @\@llvm@ globals?
isBuiltinLlvmVar :: LlvmVar -> Bool
isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) =
- "$llvm" `isPrefixOf` unpackFS lbl
+ "llvm." `isPrefixOf` unpackFS lbl
isBuiltinLlvmVar _ = False
-- | Here we take a global variable definition, rename it with a
=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -125,7 +125,7 @@ genGlobalLabelArray var_nm clbls = do
prio = LMStaticLit $ LMIntLit 0xffff i32
in LMStaticStrucU [prio, fn, null] entry_ty
- arr_var = LMGlobalVar var_nm arr_ty Internal Nothing Nothing Global
+ arr_var = LMGlobalVar var_nm arr_ty Appending Nothing Nothing Global
mkFunTy lbl = LMFunction $ LlvmFunctionDecl lbl ExternallyVisible CC_Ccc LMVoid FixedArgs [] Nothing
entry_ty = LMStructU [i32, LMPointer $ mkFunTy $ fsLit "placeholder", LMPointer i8]
arr_ty = LMArray (length clbls) entry_ty
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/165f98d86f59b783511f8015dc1e54…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/165f98d86f59b783511f8015dc1e54…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/chreekat/ci-timings] 3 commits: CI: Fix and clean up capture of timings
by Bryan R (＠chreekat) 08 May '25
by Bryan R (＠chreekat) 08 May '25
08 May '25
Bryan R pushed to branch wip/chreekat/ci-timings at Glasgow Haskell Compiler / GHC
Commits:
444c3e88 by Bryan Richter at 2025-05-08T12:00:59+03:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
027b109a by Bryan Richter at 2025-05-08T12:00:59+03:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
12416a18 by Bryan Richter at 2025-05-08T12:00:59+03:00
CI: Add more collapsible sections
- - - - -
5 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -367,7 +367,7 @@ lint-submods-branch:
- .gitlab/ci.sh setup
after_script:
- .gitlab/ci.sh save_cache
- - cat ci-timings
+ - cat ci_timings.txt
variables:
GHC_FLAGS: -Werror
cache:
@@ -419,7 +419,7 @@ hadrian-ghc-in-ghci:
- echo ":q" | HADRIAN_ARGS=-j$CORES hadrian/ghci -j$CORES | tail -n2 | grep "Ok,"
after_script:
- .gitlab/ci.sh save_cache
- - cat ci-timings
+ - cat ci_timings.txt
cache:
key: hadrian-ghci-$CACHE_REV
paths:
=====================================
.gitlab/ci.sh
=====================================
@@ -34,7 +34,11 @@ function time_it() {
local delta=$(expr $end - $start)
echo "$name took $delta seconds"
- printf "%15s | $delta" > ci-timings
+ if [[ ! -e ci_timings.txt ]]; then
+ echo "=== TIMINGS ===" > ci_timings.txt
+ fi
+
+ printf "%15s | $delta\n" $name >> ci_timings.txt
return $res
}
@@ -239,8 +243,6 @@ function cabal_update() {
# Extract GHC toolchain
function setup() {
- echo "=== TIMINGS ===" > ci-timings
-
if [ -d "$CABAL_CACHE" ]; then
info "Extracting cabal cache from $CABAL_CACHE to $CABAL_DIR..."
mkdir -p "$CABAL_DIR"
@@ -279,7 +281,7 @@ function fetch_ghc() {
fail "neither GHC nor GHC_VERSION are not set"
fi
- start_section "fetch GHC"
+ start_section fetch-ghc "Fetch GHC"
url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…"
info "Fetching GHC binary distribution from $url..."
curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution"
@@ -296,7 +298,7 @@ function fetch_ghc() {
;;
esac
rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz
- end_section "fetch GHC"
+ end_section fetch-ghc
fi
}
@@ -308,7 +310,7 @@ function fetch_cabal() {
fail "neither CABAL nor CABAL_INSTALL_VERSION are not set"
fi
- start_section "fetch cabal"
+ start_section fetch-cabal "Fetch Cabal"
case "$(uname)" in
# N.B. Windows uses zip whereas all others use .tar.xz
MSYS_*|MINGW*)
@@ -341,7 +343,7 @@ function fetch_cabal() {
fi
;;
esac
- end_section "fetch cabal"
+ end_section fetch-cabal
fi
}
@@ -349,6 +351,7 @@ function fetch_cabal() {
# here. For Docker platforms this is done in the Docker image
# build.
function setup_toolchain() {
+ start_section setup-toolchain "Setup toolchain"
fetch_ghc
fetch_cabal
cabal_update
@@ -371,10 +374,11 @@ function setup_toolchain() {
info "Building alex..."
$cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION"
+ end_section setup-toolchain
}
function cleanup_submodules() {
- start_section "clean submodules"
+ start_section clean-submodules "Clean submodules"
if [ -d .git ]; then
info "Cleaning submodules..."
# On Windows submodules can inexplicably get into funky states where git
@@ -386,7 +390,7 @@ function cleanup_submodules() {
else
info "Not cleaning submodules, not in a git repo"
fi;
- end_section "clean submodules"
+ end_section clean-submodules
}
function configure() {
@@ -486,6 +490,8 @@ function check_release_build() {
}
function build_hadrian() {
+ start_section build-hadrian "Build via Hadrian"
+
if [ -z "${BIN_DIST_NAME:-}" ]; then
fail "BIN_DIST_NAME not set"
fi
@@ -519,7 +525,7 @@ function build_hadrian() {
;;
esac
fi
-
+ end_section build-hadrian
}
# run's `make DESTDIR=$1 install` and then
@@ -545,6 +551,7 @@ function make_install_destdir() {
# install the binary distribution in directory $1 to $2.
function install_bindist() {
+ start_section install-bindist "Install bindist"
case "${CONFIGURE_WRAPPER:-}" in
emconfigure) source "$EMSDK/emsdk_env.sh" ;;
*) ;;
@@ -576,9 +583,11 @@ function install_bindist() {
;;
esac
popd
+ end_section install-bindist
}
function test_hadrian() {
+ start_section test-hadrian "Test via Hadrian"
check_msys2_deps _build/stage1/bin/ghc --version
check_release_build
@@ -685,6 +694,7 @@ function test_hadrian() {
info "STAGE2_TEST=$?"
fi
+ end_section test-hadrian
}
function summarise_hi_files() {
@@ -719,7 +729,7 @@ function cabal_abi_test() {
pushd $DIR
echo $PWD
- start_section "Cabal test: $OUT"
+ start_section cabal-abi-test "Cabal ABI test: $OUT"
mkdir -p "$OUT"
"$HC" \
-hidir tmp -odir tmp -fforce-recomp -haddock \
@@ -729,7 +739,7 @@ function cabal_abi_test() {
summarise_hi_files
summarise_o_files
popd
- end_section "Cabal test: $OUT"
+ end_section cabal-abi-test
}
function cabal_test() {
@@ -737,7 +747,7 @@ function cabal_test() {
fail "OUT not set"
fi
- start_section "Cabal test: $OUT"
+ start_section cabal-test "Cabal test: $OUT"
mkdir -p "$OUT"
run "$HC" \
-hidir tmp -odir tmp -fforce-recomp \
@@ -746,7 +756,7 @@ function cabal_test() {
-ilibraries/Cabal/Cabal/src -XNoPolyKinds Distribution.Simple \
"$@" 2>&1 | tee $OUT/log
rm -Rf tmp
- end_section "Cabal test: $OUT"
+ end_section cabal-test
}
function run_perf_test() {
=====================================
.gitlab/common.sh
=====================================
@@ -20,15 +20,18 @@ WHITE="1;37"
LT_GRAY="0;37"
# GitLab Pipelines log section delimiters
-# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664
-start_section() {
- name="$1"
- echo -e "section_start:$(date +%s):$name\015\033[0K"
+# https://docs.gitlab.com/ci/jobs/job_logs/#custom-collapsible-sections
+function start_section () {
+ local section_title="${1}"
+ local section_description="${2:-$section_title}"
+
+ echo -e "section_start:$(date +%s):${section_title}[collapsed=true]\r\e[0K${section_description}"
}
-end_section() {
- name="$1"
- echo -e "section_end:$(date +%s):$name\015\033[0K"
+function end_section () {
+ local section_title="${1}"
+
+ echo -e "section_end:$(date +%s):${section_title}\r\e[0K"
}
echo_color() {
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -853,7 +853,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} }
[ ".gitlab/ci.sh save_cache"
, ".gitlab/ci.sh save_test_output"
, ".gitlab/ci.sh clean"
- , "cat ci_timings"
+ , "cat ci_timings.txt"
]
jobFlavour = mkJobFlavour buildConfig
=====================================
.gitlab/jobs.yaml
=====================================
@@ -5,7 +5,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -71,7 +71,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -134,7 +134,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -196,7 +196,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -258,7 +258,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -320,7 +320,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -383,7 +383,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -445,7 +445,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -507,7 +507,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -574,7 +574,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -638,7 +638,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -701,7 +701,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -764,7 +764,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -827,7 +827,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -891,7 +891,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -954,7 +954,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1017,7 +1017,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1087,7 +1087,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1153,7 +1153,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -1217,7 +1217,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1281,7 +1281,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1345,7 +1345,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1409,7 +1409,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1474,7 +1474,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1539,7 +1539,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1604,7 +1604,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1667,7 +1667,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1730,7 +1730,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1795,7 +1795,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1861,7 +1861,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1924,7 +1924,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -1987,7 +1987,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -2050,7 +2050,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2114,7 +2114,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2177,7 +2177,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2242,7 +2242,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2305,7 +2305,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2368,7 +2368,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2431,7 +2431,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2494,7 +2494,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -2559,7 +2559,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2622,7 +2622,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2685,7 +2685,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2750,7 +2750,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2816,7 +2816,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2881,7 +2881,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -2944,7 +2944,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3007,7 +3007,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3070,7 +3070,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3133,7 +3133,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3196,7 +3196,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3385,7 +3385,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3453,7 +3453,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3518,7 +3518,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3582,7 +3582,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3646,7 +3646,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -3711,7 +3711,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3775,7 +3775,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3839,7 +3839,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3910,7 +3910,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -3977,7 +3977,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -4042,7 +4042,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4107,7 +4107,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4172,7 +4172,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4237,7 +4237,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4301,7 +4301,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4365,7 +4365,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4429,7 +4429,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4493,7 +4493,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4557,7 +4557,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4623,7 +4623,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4689,7 +4689,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4756,7 +4756,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4820,7 +4820,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4884,7 +4884,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -4948,7 +4948,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5012,7 +5012,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5076,7 +5076,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5268,7 +5268,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5337,7 +5337,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5402,7 +5402,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -5465,7 +5465,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5528,7 +5528,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5591,7 +5591,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5654,7 +5654,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5718,7 +5718,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5783,7 +5783,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5848,7 +5848,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5910,7 +5910,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -5972,7 +5972,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6036,7 +6036,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6101,7 +6101,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6163,7 +6163,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6225,7 +6225,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6288,7 +6288,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6351,7 +6351,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6413,7 +6413,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6477,7 +6477,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6539,7 +6539,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6601,7 +6601,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6663,7 +6663,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6725,7 +6725,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": true,
"artifacts": {
@@ -6790,7 +6790,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6852,7 +6852,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6914,7 +6914,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -6978,7 +6978,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7043,7 +7043,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7107,7 +7107,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7169,7 +7169,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7231,7 +7231,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7293,7 +7293,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7355,7 +7355,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
@@ -7417,7 +7417,7 @@
".gitlab/ci.sh save_cache",
".gitlab/ci.sh save_test_output",
".gitlab/ci.sh clean",
- "cat ci_timings"
+ "cat ci_timings.txt"
],
"allow_failure": false,
"artifacts": {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/059c3b536101e5f350179825ef9991…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/059c3b536101e5f350179825ef9991…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26015] 4 commits: Refactor mkTopLevImportedEnv out of mkTopLevEnv
by Simon Peyton Jones (＠simonpj) 08 May '25
by Simon Peyton Jones (＠simonpj) 08 May '25
08 May '25
Simon Peyton Jones pushed to branch wip/T26015 at Glasgow Haskell Compiler / GHC
Commits:
e46c6b18 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00
Refactor mkTopLevImportedEnv out of mkTopLevEnv
This makes the code clearer and allows the top-level import context to
be fetched directly from the HomeModInfo through the API (e.g. useful
for the debugger).
- - - - -
0ce0d263 by Rodrigo Mesquita at 2025-05-06T09:01:57-04:00
Export sizeOccEnv from GHC.Types.Name.Occurrence
Counts the number of OccNames in an OccEnv
- - - - -
165f98d8 by Simon Peyton Jones at 2025-05-06T09:02:39-04:00
Fix a bad untouchability bug im simplifyInfer
This patch addresses #26004. The root cause was that simplifyInfer
was willing to unify variables "far out". The fix, in
runTcSWithEvBinds', is to initialise the inert set given-eq level with
the current level. See
(TGE6) in Note [Tracking Given equalities]
in GHC.Tc.Solver.InertSet
Two loosely related refactors:
* Refactored approximateWCX to return just the free type
variables of the un-quantified constraints. That avoids duplication
of work (these free vars are needed in simplifyInfer) and makes it
clearer that the constraints themselves are irrelevant.
* A little local refactor of TcSMode, which reduces the number of
parameters to runTcSWithEvBinds
- - - - -
6a7d917b by Simon Peyton Jones at 2025-05-08T09:28:29+01:00
Slighty improve `dropMisleading`
Fix #26105, by upgrading the (horrible, hacky) `dropMisleading`
function.
This fix makes things a bit better but does not cure the underlying
problem.
- - - - -
14 changed files:
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Occurrence.hs
- + testsuite/tests/typecheck/should_fail/T26004.hs
- + testsuite/tests/typecheck/should_fail/T26004.stderr
- + testsuite/tests/typecheck/should_fail/T26015.hs
- + testsuite/tests/typecheck/should_fail/T26015.stderr
- testsuite/tests/typecheck/should_fail/T7453.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
compiler/GHC/HsToCore/Pmc/Solver/Types.hs
=====================================
@@ -64,7 +64,7 @@ import GHC.Builtin.Names
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Tc.Solver.InertSet (InertSet, emptyInert)
-import GHC.Tc.Utils.TcType (isStringTy)
+import GHC.Tc.Utils.TcType (isStringTy, topTcLevel)
import GHC.Types.CompleteMatch
import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit
, fractionalLitFromRational
@@ -129,7 +129,7 @@ instance Outputable TyState where
ppr (TySt n inert) = ppr n <+> ppr inert
initTyState :: TyState
-initTyState = TySt 0 emptyInert
+initTyState = TySt 0 (emptyInert topTcLevel)
-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These
-- entries are possibly shared when we figure out that two variables must be
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -23,7 +23,7 @@ module GHC.Runtime.Eval (
setupBreakpoint,
back, forward,
setContext, getContext,
- mkTopLevEnv,
+ mkTopLevEnv, mkTopLevImportedEnv,
getNamesInScope,
getRdrNamesInScope,
moduleIsInterpreted,
@@ -836,29 +836,36 @@ mkTopLevEnv hsc_env modl
Nothing -> pure $ Left "not a home module"
Just details ->
case mi_top_env (hm_iface details) of
- (IfaceTopEnv exports imports) -> do
- imports_env <-
- runInteractiveHsc hsc_env
- $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env
- $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
- $ forM imports $ \iface_import -> do
- let ImpUserSpec spec details = tcIfaceImport iface_import
- iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec)
- pure $ case details of
- ImpUserAll -> importsFromIface hsc_env iface spec Nothing
- ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
- ImpUserExplicit x _parents_of_implicits ->
- -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y).
- -- It is only used for error messages. It seems dubious even to add an import context to these GREs as
- -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that
- -- the test case produce the same output as before.
- let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } }
- in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x
+ (IfaceTopEnv exports _imports) -> do
+ imports_env <- mkTopLevImportedEnv hsc_env details
let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports)
pure $ Right $ plusGlobalRdrEnv imports_env exports_env
where
hpt = hsc_HPT hsc_env
+-- | Make the top-level environment with all bindings imported by this module.
+-- Exported bindings from this module are not included in the result.
+mkTopLevImportedEnv :: HscEnv -> HomeModInfo -> IO GlobalRdrEnv
+mkTopLevImportedEnv hsc_env details = do
+ runInteractiveHsc hsc_env
+ $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env
+ $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
+ $ forM imports $ \iface_import -> do
+ let ImpUserSpec spec details = tcIfaceImport iface_import
+ iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec)
+ pure $ case details of
+ ImpUserAll -> importsFromIface hsc_env iface spec Nothing
+ ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
+ ImpUserExplicit x _parents_of_implicits ->
+ -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y).
+ -- It is only used for error messages. It seems dubious even to add an import context to these GREs as
+ -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that
+ -- the test case produce the same output as before.
+ let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } }
+ in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x
+ where
+ IfaceTopEnv _ imports = mi_top_env (hm_iface details)
+
-- | Get the interactive evaluation context, consisting of a pair of the
-- set of modules from which we take the full top-level scope, and the set
-- of modules from which we take just the exports respectively.
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -915,21 +915,22 @@ simplifyInfer top_lvl rhs_tclvl infer_mode sigs name_taus wanteds
; let psig_theta = concatMap sig_inst_theta partial_sigs
-- First do full-blown solving
- -- NB: we must gather up all the bindings from doing
- -- this solving; hence (runTcSWithEvBinds ev_binds_var).
- -- And note that since there are nested implications,
- -- calling solveWanteds will side-effect their evidence
- -- bindings, so we can't just revert to the input
- -- constraint.
-
+ -- NB: we must gather up all the bindings from doing this solving; hence
+ -- (runTcSWithEvBinds ev_binds_var). And note that since there are
+ -- nested implications, calling solveWanteds will side-effect their
+ -- evidence bindings, so we can't just revert to the input constraint.
+ --
+ -- See also Note [Inferring principal types]
; ev_binds_var <- TcM.newTcEvBinds
; psig_evs <- newWanteds AnnOrigin psig_theta
; wanted_transformed
- <- setTcLevel rhs_tclvl $
- runTcSWithEvBinds ev_binds_var $
+ <- runTcSWithEvBinds ev_binds_var $
+ setTcLevelTcS rhs_tclvl $
solveWanteds (mkSimpleWC psig_evs `andWC` wanteds)
+ -- setLevelTcS: we do setLevel /inside/ the runTcS, so that
+ -- we initialise the InertSet inert_given_eq_lvl as far
+ -- out as possible, maximising oppportunities to unify
-- psig_evs : see Note [Add signature contexts as wanteds]
- -- See Note [Inferring principal types]
-- Find quant_pred_candidates, the predicates that
-- we'll consider quantifying over
@@ -1430,13 +1431,15 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted
-- Step 1 of Note [decideAndPromoteTyVars]
-- Get candidate constraints, decide which we can potentially quantify
- (can_quant_cts, no_quant_cts) = approximateWCX wanted
+ -- The `no_quant_tvs` are free in constraints we can't quantify.
+ (can_quant_cts, no_quant_tvs) = approximateWCX False wanted
can_quant = ctsPreds can_quant_cts
- no_quant = ctsPreds no_quant_cts
+ can_quant_tvs = tyCoVarsOfTypes can_quant
-- Step 2 of Note [decideAndPromoteTyVars]
-- Apply the monomorphism restriction
(post_mr_quant, mr_no_quant) = applyMR dflags infer_mode can_quant
+ mr_no_quant_tvs = tyCoVarsOfTypes mr_no_quant
-- The co_var_tvs are tvs mentioned in the types of covars or
-- coercion holes. We can't quantify over these covars, so we
@@ -1448,30 +1451,33 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted
++ tau_tys ++ post_mr_quant)
co_var_tvs = closeOverKinds co_vars
- -- outer_tvs are mentioned in `wanted, and belong to some outer level.
+ -- outer_tvs are mentioned in `wanted`, and belong to some outer level.
-- We definitely can't quantify over them
outer_tvs = outerLevelTyVars rhs_tclvl $
- tyCoVarsOfTypes can_quant `unionVarSet` tyCoVarsOfTypes no_quant
+ can_quant_tvs `unionVarSet` no_quant_tvs
- -- Step 3 of Note [decideAndPromoteTyVars]
+ -- Step 3 of Note [decideAndPromoteTyVars], (a-c)
-- Identify mono_tvs: the type variables that we must not quantify over
+ -- At top level we are much less keen to create mono tyvars, to avoid
+ -- spooky action at a distance.
mono_tvs_without_mr
- | is_top_level = outer_tvs
- | otherwise = outer_tvs -- (a)
- `unionVarSet` tyCoVarsOfTypes no_quant -- (b)
- `unionVarSet` co_var_tvs -- (c)
+ | is_top_level = outer_tvs -- See (DP2)
+ | otherwise = outer_tvs -- (a)
+ `unionVarSet` no_quant_tvs -- (b)
+ `unionVarSet` co_var_tvs -- (c)
+ -- Step 3 of Note [decideAndPromoteTyVars], (d)
mono_tvs_with_mr
= -- Even at top level, we don't quantify over type variables
-- mentioned in constraints that the MR tells us not to quantify
-- See Note [decideAndPromoteTyVars] (DP2)
- mono_tvs_without_mr `unionVarSet` tyCoVarsOfTypes mr_no_quant
+ mono_tvs_without_mr `unionVarSet` mr_no_quant_tvs
--------------------------------------------------------------------
-- Step 4 of Note [decideAndPromoteTyVars]
-- Use closeWrtFunDeps to find any other variables that are determined by mono_tvs
- add_determined tvs = closeWrtFunDeps post_mr_quant tvs
- `delVarSetList` psig_qtvs
+ add_determined tvs preds = closeWrtFunDeps preds tvs
+ `delVarSetList` psig_qtvs
-- Why delVarSetList psig_qtvs?
-- If the user has explicitly asked for quantification, then that
-- request "wins" over the MR.
@@ -1480,8 +1486,8 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted
-- (i.e. says "no" to isQuantifiableTv)? That's OK: explanation
-- in Step 2 of Note [Deciding quantification].
- mono_tvs_with_mr_det = add_determined mono_tvs_with_mr
- mono_tvs_without_mr_det = add_determined mono_tvs_without_mr
+ mono_tvs_with_mr_det = add_determined mono_tvs_with_mr post_mr_quant
+ mono_tvs_without_mr_det = add_determined mono_tvs_without_mr can_quant
--------------------------------------------------------------------
-- Step 5 of Note [decideAndPromoteTyVars]
@@ -1518,7 +1524,7 @@ decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted
, text "newly_mono_tvs =" <+> ppr newly_mono_tvs
, text "can_quant =" <+> ppr can_quant
, text "post_mr_quant =" <+> ppr post_mr_quant
- , text "no_quant =" <+> ppr no_quant
+ , text "no_quant_tvs =" <+> ppr no_quant_tvs
, text "mr_no_quant =" <+> ppr mr_no_quant
, text "final_quant =" <+> ppr final_quant
, text "co_vars =" <+> ppr co_vars ]
@@ -1605,8 +1611,8 @@ The plan
The body of z tries to unify the type of x (call it alpha[1]) with
(beta[2] -> gamma[2]). This unification fails because alpha is untouchable, leaving
[W] alpha[1] ~ (beta[2] -> gamma[2])
- We need to know not to quantify over beta or gamma, because they are in the
- equality constraint with alpha. Actual test case: typecheck/should_compile/tc213
+ We don't want to quantify over beta or gamma because they are fixed by alpha,
+ which is monomorphic. Actual test case: typecheck/should_compile/tc213
Another example. Suppose we have
class C a b | a -> b
@@ -1643,9 +1649,22 @@ Wrinkles
promote type variables. But for bindings affected by the MR we have no choice
but to promote.
+ An example is in #26004.
+ f w e = case e of
+ T1 -> let y = not w in False
+ T2 -> True
+ When generalising `f` we have a constraint
+ forall. (a ~ Bool) => alpha ~ Bool
+ where our provisional type for `f` is `f :: T alpha -> blah`.
+ In a /nested/ setting, we might simply not-generalise `f`, hoping to learn
+ about `alpha` from f's call sites (test T5266b is an example). But at top
+ level, to avoid spooky action at a distance.
+
Note [The top-level Any principle]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Key principle: we never want to show the programmer a type with `Any` in it.
+Key principles:
+ * we never want to show the programmer a type with `Any` in it.
+ * avoid "spooky action at a distance" and silent defaulting
Most /top level/ bindings have a type signature, so none of this arises. But
where a top-level binding lacks a signature, we don't want to infer a type like
@@ -1654,11 +1673,18 @@ and then subsequently default alpha[0]:=Any. Exposing `Any` to the user is bad
bad bad. Better to report an error, which is what may well happen if we
quantify over alpha instead.
+Moreover,
+ * If (elsewhere in this module) we add a call to `f`, say (f True), then
+ `f` will get the type `Bool -> Int`
+ * If we add /another/ call, say (f 'x'), we will then get a type error.
+ * If we have no calls, the final exported type of `f` may get set by
+ defaulting, and might not be principal (#26004).
+
For /nested/ bindings, a monomorphic type like `f :: alpha[0] -> Int` is fine,
because we can see all the call sites of `f`, and they will probably fix
`alpha`. In contrast, we can't see all of (or perhaps any of) the calls of
top-level (exported) functions, reducing the worries about "spooky action at a
-distance".
+distance". This also moves in the direction of `MonoLocalBinds`, which we like.
Note [Do not quantify over constraints that determine a variable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/Solver/InertSet.hs
=====================================
@@ -374,20 +374,20 @@ instance Outputable InertSet where
where
dicts = bagToList (dictsToBag solved_dicts)
-emptyInertCans :: InertCans
-emptyInertCans
+emptyInertCans :: TcLevel -> InertCans
+emptyInertCans given_eq_lvl
= IC { inert_eqs = emptyTyEqs
, inert_funeqs = emptyFunEqs
- , inert_given_eq_lvl = topTcLevel
+ , inert_given_eq_lvl = given_eq_lvl
, inert_given_eqs = False
, inert_dicts = emptyDictMap
, inert_safehask = emptyDictMap
, inert_insts = []
, inert_irreds = emptyBag }
-emptyInert :: InertSet
-emptyInert
- = IS { inert_cans = emptyInertCans
+emptyInert :: TcLevel -> InertSet
+emptyInert given_eq_lvl
+ = IS { inert_cans = emptyInertCans given_eq_lvl
, inert_cycle_breakers = emptyBag :| []
, inert_famapp_cache = emptyFunEqs
, inert_solved_dicts = emptyDictMap }
@@ -678,6 +678,23 @@ should update inert_given_eq_lvl?
imply nominal ones. For example, if (G a ~R G b) and G's argument's
role is nominal, then we can deduce a ~N b.
+(TGE6) A subtle point is this: when initialising the solver, giving it
+ an empty InertSet, we must conservatively initialise `inert_given_lvl`
+ to the /current/ TcLevel. This matters when doing let-generalisation.
+ Consider #26004:
+ f w e = case e of
+ T1 -> let y = not w in False -- T1 is a GADT
+ T2 -> True
+ When let-generalising `y`, we will have (w :: alpha[1]) in the type
+ envt; and we are under GADT pattern match. So when we solve the
+ constraints from y's RHS, in simplifyInfer, we must NOT unify
+ alpha[1] := Bool
+ Since we don't know what enclosing equalities there are, we just
+ conservatively assume that there are some.
+
+ This initialisation in done in `runTcSWithEvBinds`, which passes
+ the current TcLevl to `emptyInert`.
+
Historical note: prior to #24938 we also ignored Given equalities that
did not mention an "outer" type variable. But that is wrong, as #24938
showed. Another example is immortalised in test LocalGivenEqs2
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -20,7 +20,7 @@ module GHC.Tc.Solver.Monad (
runTcSSpecPrag,
failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS,
runTcSEqualities,
- nestTcS, nestImplicTcS, setEvBindsTcS,
+ nestTcS, nestImplicTcS, setEvBindsTcS, setTcLevelTcS,
emitImplicationTcS, emitTvImplicationTcS,
emitImplication,
emitFunDepWanteds,
@@ -947,8 +947,9 @@ added. This is initialised from the innermost implication constraint.
-- | See Note [TcSMode]
data TcSMode
= TcSVanilla -- ^ Normal constraint solving
+ | TcSPMCheck -- ^ Used when doing patterm match overlap checks
| TcSEarlyAbort -- ^ Abort early on insoluble constraints
- | TcSSpecPrag -- ^ Fully solve all constraints
+ | TcSSpecPrag -- ^ Fully solve all constraints
deriving (Eq)
{- Note [TcSMode]
@@ -957,6 +958,11 @@ The constraint solver can operate in different modes:
* TcSVanilla: Normal constraint solving mode. This is the default.
+* TcSPMCheck: Used by the pattern match overlap checker.
+ Like TcSVanilla, but the idea is that the returned InertSet will
+ later be resumed, so we do not want to restore type-equality cycles
+ See also Note [Type equality cycles] in GHC.Tc.Solver.Equality
+
* TcSEarlyAbort: Abort (fail in the monad) as soon as we come across an
insoluble constraint. This is used to fail-fast when checking for hole-fits.
See Note [Speeding up valid hole-fits].
@@ -1135,7 +1141,7 @@ runTcS tcs
runTcSEarlyAbort :: TcS a -> TcM a
runTcSEarlyAbort tcs
= do { ev_binds_var <- TcM.newTcEvBinds
- ; runTcSWithEvBinds' True TcSEarlyAbort ev_binds_var tcs }
+ ; runTcSWithEvBinds' TcSEarlyAbort ev_binds_var tcs }
-- | Run the 'TcS' monad in 'TcSSpecPrag' mode, which either fully solves
-- individual Wanted quantified constraints or leaves them alone.
@@ -1143,7 +1149,7 @@ runTcSEarlyAbort tcs
-- See Note [TcSSpecPrag].
runTcSSpecPrag :: EvBindsVar -> TcS a -> TcM a
runTcSSpecPrag ev_binds_var tcs
- = runTcSWithEvBinds' True TcSSpecPrag ev_binds_var tcs
+ = runTcSWithEvBinds' TcSSpecPrag ev_binds_var tcs
{- Note [TcSSpecPrag]
~~~~~~~~~~~~~~~~~~~~~
@@ -1200,7 +1206,7 @@ runTcSEqualities thing_inside
runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet)
runTcSInerts inerts tcs = do
ev_binds_var <- TcM.newTcEvBinds
- runTcSWithEvBinds' False TcSVanilla ev_binds_var $ do
+ runTcSWithEvBinds' TcSPMCheck ev_binds_var $ do
setInertSet inerts
a <- tcs
new_inerts <- getInertSet
@@ -1209,21 +1215,23 @@ runTcSInerts inerts tcs = do
runTcSWithEvBinds :: EvBindsVar
-> TcS a
-> TcM a
-runTcSWithEvBinds = runTcSWithEvBinds' True TcSVanilla
+runTcSWithEvBinds = runTcSWithEvBinds' TcSVanilla
-runTcSWithEvBinds' :: Bool -- True <=> restore type equality cycles
- -- Don't if you want to reuse the InertSet.
- -- See also Note [Type equality cycles]
- -- in GHC.Tc.Solver.Equality
- -> TcSMode
+runTcSWithEvBinds' :: TcSMode
-> EvBindsVar
-> TcS a
-> TcM a
-runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs
+runTcSWithEvBinds' mode ev_binds_var tcs
= do { unified_var <- TcM.newTcRef 0
- ; step_count <- TcM.newTcRef 0
- ; inert_var <- TcM.newTcRef emptyInert
- ; wl_var <- TcM.newTcRef emptyWorkList
+ ; step_count <- TcM.newTcRef 0
+
+ -- Make a fresh, empty inert set
+ -- Subtle point: see (TGE6) in Note [Tracking Given equalities]
+ -- in GHC.Tc.Solver.InertSet
+ ; tc_lvl <- TcM.getTcLevel
+ ; inert_var <- TcM.newTcRef (emptyInert tc_lvl)
+
+ ; wl_var <- TcM.newTcRef emptyWorkList
; unif_lvl_var <- TcM.newTcRef Nothing
; let env = TcSEnv { tcs_ev_binds = ev_binds_var
, tcs_unified = unified_var
@@ -1240,9 +1248,13 @@ runTcSWithEvBinds' restore_cycles mode ev_binds_var tcs
; when (count > 0) $
csTraceTcM $ return (text "Constraint solver steps =" <+> int count)
- ; when restore_cycles $
- do { inert_set <- TcM.readTcRef inert_var
- ; restoreTyVarCycles inert_set }
+ -- Restore tyvar cycles: see Note [Type equality cycles] in
+ -- GHC.Tc.Solver.Equality
+ -- But /not/ in TCsPMCheck mode: see Note [TcSMode]
+ ; case mode of
+ TcSPMCheck -> return ()
+ _ -> do { inert_set <- TcM.readTcRef inert_var
+ ; restoreTyVarCycles inert_set }
#if defined(DEBUG)
; ev_binds <- TcM.getTcEvBindsMap ev_binds_var
@@ -1284,6 +1296,10 @@ setEvBindsTcS :: EvBindsVar -> TcS a -> TcS a
setEvBindsTcS ref (TcS thing_inside)
= TcS $ \ env -> thing_inside (env { tcs_ev_binds = ref })
+setTcLevelTcS :: TcLevel -> TcS a -> TcS a
+setTcLevelTcS lvl (TcS thing_inside)
+ = TcS $ \ env -> TcM.setTcLevel lvl (thing_inside env)
+
nestImplicTcS :: EvBindsVar
-> TcLevel -> TcS a
-> TcS a
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -1181,9 +1181,12 @@ dropMisleading (WC { wc_simple = simples, wc_impl = implics, wc_errors = errors
, wc_impl = mapBag drop_implic implics
, wc_errors = filterBag keep_delayed_error errors }
- keep_ct ct = case classifyPredType (ctPred ct) of
- ClassPred {} -> False
- _ -> True
+ keep_ct ct
+ = case classifyPredType (ctPred ct) of
+ ClassPred cls _ -> isEqualityClass cls
+ -- isEqualityClass: see (CERR2) in Note [Constraints and errors]
+ -- in GHC.Tc.Utils.Monad
+ _ -> True
keep_delayed_error (DE_Hole hole) = isOutOfScopeHole hole
keep_delayed_error (DE_NotConcrete {}) = True
@@ -1743,24 +1746,21 @@ will be able to report a more informative error:
************************************************************************
-}
-type ApproxWC = ( Bag Ct -- Free quantifiable constraints
- , Bag Ct ) -- Free non-quantifiable constraints
- -- due to shape, or enclosing equality
+type ApproxWC = ( Bag Ct -- Free quantifiable constraints
+ , TcTyCoVarSet ) -- Free vars of non-quantifiable constraints
+ -- due to shape, or enclosing equality
approximateWC :: Bool -> WantedConstraints -> Bag Ct
approximateWC include_non_quantifiable cts
- | include_non_quantifiable = quant `unionBags` no_quant
- | otherwise = quant
- where
- (quant, no_quant) = approximateWCX cts
+ = fst (approximateWCX include_non_quantifiable cts)
-approximateWCX :: WantedConstraints -> ApproxWC
+approximateWCX :: Bool -> WantedConstraints -> ApproxWC
-- The "X" means "extended";
-- we return both quantifiable and non-quantifiable constraints
-- See Note [ApproximateWC]
-- See Note [floatKindEqualities vs approximateWC]
-approximateWCX wc
- = float_wc False emptyVarSet wc (emptyBag, emptyBag)
+approximateWCX include_non_quantifiable wc
+ = float_wc False emptyVarSet wc (emptyBag, emptyVarSet)
where
float_wc :: Bool -- True <=> there are enclosing equalities
-> TcTyCoVarSet -- Enclosing skolem binders
@@ -1786,17 +1786,23 @@ approximateWCX wc
-- There can be (insoluble) Given constraints in wc_simple,
-- there so that we get error reports for unreachable code
-- See `given_insols` in GHC.Tc.Solver.Solve.solveImplication
- | insolubleCt ct = acc
- | tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = acc
- | otherwise
- = case classifyPredType (ctPred ct) of
+ | insolubleCt ct = acc
+ | pred_tvs `intersectsVarSet` skol_tvs = acc
+ | include_non_quantifiable = add_to_quant
+ | is_quantifiable encl_eqs (ctPred ct) = add_to_quant
+ | otherwise = add_to_no_quant
+ where
+ pred = ctPred ct
+ pred_tvs = tyCoVarsOfType pred
+ add_to_quant = (ct `consBag` quant, no_quant)
+ add_to_no_quant = (quant, no_quant `unionVarSet` pred_tvs)
+
+ is_quantifiable encl_eqs pred
+ = case classifyPredType pred of
-- See the classification in Note [ApproximateWC]
EqPred eq_rel ty1 ty2
- | not encl_eqs -- See Wrinkle (W1)
- , quantify_equality eq_rel ty1 ty2
- -> add_to_quant
- | otherwise
- -> add_to_no_quant
+ | encl_eqs -> False -- encl_eqs: See Wrinkle (W1)
+ | otherwise -> quantify_equality eq_rel ty1 ty2
ClassPred cls tys
| Just {} <- isCallStackPred cls tys
@@ -1804,17 +1810,14 @@ approximateWCX wc
-- the constraints bubble up to be solved from the outer
-- context, or be defaulted when we reach the top-level.
-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
- -> add_to_no_quant
+ -> False
| otherwise
- -> add_to_quant -- See Wrinkle (W2)
+ -> True -- See Wrinkle (W2)
- IrredPred {} -> add_to_quant -- See Wrinkle (W2)
+ IrredPred {} -> True -- See Wrinkle (W2)
- ForAllPred {} -> add_to_no_quant -- Never quantify these
- where
- add_to_quant = (ct `consBag` quant, no_quant)
- add_to_no_quant = (quant, ct `consBag` no_quant)
+ ForAllPred {} -> False -- Never quantify these
-- See Note [Quantifying over equality constraints]
quantify_equality NomEq ty1 ty2 = quant_fun ty1 || quant_fun ty2
@@ -1852,7 +1855,7 @@ We proceed by classifying the constraint:
Wrinkle (W1)
When inferring most-general types (in simplifyInfer), we
- do *not* float an equality constraint if the implication binds
+ do *not* quantify over equality constraint if the implication binds
equality constraints, because that defeats the OutsideIn story.
Consider data T a where { TInt :: T Int; MkT :: T a }
f TInt = 3::Int
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1385,11 +1385,13 @@ tryCaptureConstraints thing_inside
tcTryM thing_inside
-- See Note [Constraints and errors]
- ; let lie_to_keep = case mb_res of
- Nothing -> dropMisleading lie
- Just {} -> lie
-
- ; return (mb_res, lie_to_keep) }
+ ; case mb_res of
+ Just {} -> return (mb_res, lie)
+ Nothing -> do { let pruned_lie = dropMisleading lie
+ ; traceTc "tryCaptureConstraints" $
+ vcat [ text "lie:" <+> ppr lie
+ , text "dropMisleading lie:" <+> ppr pruned_lie ]
+ ; return (Nothing, pruned_lie) } }
captureConstraints :: TcM a -> TcM (a, WantedConstraints)
-- (captureConstraints m) runs m, and returns the type constraints it generates
@@ -2066,28 +2068,51 @@ It's distressingly delicate though:
emitted some constraints with skolem-escape problems.
* If we discard too /few/ constraints, we may get the misleading
- class constraints mentioned above. But we may /also/ end up taking
- constraints built at some inner level, and emitting them at some
- outer level, and then breaking the TcLevel invariants
- See Note [TcLevel invariants] in GHC.Tc.Utils.TcType
-
-So dropMisleading has a horridly ad-hoc structure. It keeps only
-/insoluble/ flat constraints (which are unlikely to very visibly trip
-up on the TcLevel invariant, but all /implication/ constraints (except
-the class constraints inside them). The implication constraints are
-OK because they set the ambient level before attempting to solve any
-inner constraints. Ugh! I hate this. But it seems to work.
-
-However note that freshly-generated constraints like (Int ~ Bool), or
-((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
-insoluble. The constraint solver does that. So they'll be discarded.
-That's probably ok; but see th/5358 as a not-so-good example:
- t1 :: Int
- t1 x = x -- Manifestly wrong
-
- foo = $(...raises exception...)
-We report the exception, but not the bug in t1. Oh well. Possible
-solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
+ class constraints mentioned above.
+
+ We may /also/ end up taking constraints built at some inner level, and
+ emitting them (via the exception catching in `tryCaptureConstraints` at some
+ outer level, and then breaking the TcLevel invariants See Note [TcLevel
+ invariants] in GHC.Tc.Utils.TcType
+
+So `dropMisleading` has a horridly ad-hoc structure:
+
+* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
+ trip up on the TcLevel invariant
+
+* But it keeps all /implication/ constraints (except the class constraints
+ inside them). The implication constraints are OK because they set the ambient
+ level before attempting to solve any inner constraints.
+
+Ugh! I hate this. But it seems to work.
+
+Other wrinkles
+
+(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
+ ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
+ insoluble. The constraint solver does that. So they'll be discarded.
+ That's probably ok; but see th/5358 as a not-so-good example:
+ t1 :: Int
+ t1 x = x -- Manifestly wrong
+
+ foo = $(...raises exception...)
+ We report the exception, but not the bug in t1. Oh well. Possible
+ solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
+
+(CERR2) In #26015 I found that from the constraints
+ [W] alpha ~ Int -- A class constraint
+ [W] F alpha ~# Bool -- An equality constraint
+ we were dropping the first (becuase it's a class constraint) but not the
+ second, and then getting a misleading error message from the second. As
+ #25607 shows, we can get not just one but a zillion bogus messages, which
+ conceal the one genuine error. Boo.
+
+ For now I have added an even more ad-hoc "drop class constraints except
+ equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can
+ down the road; but this problem seems somewhat rare anyway. The code in
+ `dropMisleading` hasn't changed for years.
+
+It would be great to have a more systematic solution to this entire mess.
************************************************************************
=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -92,6 +92,7 @@ module GHC.Types.Name.Occurrence (
plusOccEnv, plusOccEnv_C,
extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
alterOccEnv, minusOccEnv, minusOccEnv_C, minusOccEnv_C_Ns,
+ sizeOccEnv,
pprOccEnv, forceOccEnv,
intersectOccEnv_C,
@@ -803,6 +804,10 @@ minusOccEnv_C_Ns f (MkOccEnv as) (MkOccEnv bs) =
then Nothing
else Just m
+sizeOccEnv :: OccEnv a -> Int
+sizeOccEnv (MkOccEnv as) =
+ nonDetStrictFoldUFM (\ m !acc -> acc + sizeUFM m) 0 as
+
instance Outputable a => Outputable (OccEnv a) where
ppr x = pprOccEnv ppr x
=====================================
testsuite/tests/typecheck/should_fail/T26004.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NoMonoLocalBinds #-}
+
+module T26004 where
+
+data T a where
+ T1 :: T Bool
+ T2 :: T a
+
+-- This funcion should be rejected:
+-- we should not infer a non-principal type for `f`
+f w e = case e of
+ T1 -> let y = not w in False
+ T2 -> True
=====================================
testsuite/tests/typecheck/should_fail/T26004.stderr
=====================================
@@ -0,0 +1,17 @@
+
+T26004.hs:13:21: error: [GHC-25897]
+ • Could not deduce ‘p ~ Bool’
+ from the context: a ~ Bool
+ bound by a pattern with constructor: T1 :: T Bool,
+ in a case alternative
+ at T26004.hs:13:3-4
+ ‘p’ is a rigid type variable bound by
+ the inferred type of f :: p -> T a -> Bool
+ at T26004.hs:(12,1)-(14,12)
+ • In the first argument of ‘not’, namely ‘w’
+ In the expression: not w
+ In an equation for ‘y’: y = not w
+ • Relevant bindings include
+ w :: p (bound at T26004.hs:12:3)
+ f :: p -> T a -> Bool (bound at T26004.hs:12:1)
+ Suggested fix: Consider giving ‘f’ a type signature
=====================================
testsuite/tests/typecheck/should_fail/T26015.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE MonoLocalBinds, GADTs, TypeFamilies #-}
+
+module Foo where
+
+type family F a
+type instance F Int = Bool
+
+data T where
+ T1 :: a -> T
+ T2 :: Int -> T
+
+woo :: (a ~ Int) => Int -> F a
+woo = error "urk"
+
+f x = case x of
+ T1 y -> not (woo 3)
+ T2 -> True
=====================================
testsuite/tests/typecheck/should_fail/T26015.stderr
=====================================
@@ -0,0 +1,9 @@
+T26015.hs:17:10: error: [GHC-27346]
+ • The data constructor ‘T2’ should have 1 argument, but has been given none
+ • In the pattern: T2
+ In a case alternative: T2 -> True
+ In the expression:
+ case x of
+ T1 y -> not (woo 3)
+ T2 -> True
+
=====================================
testsuite/tests/typecheck/should_fail/T7453.stderr
=====================================
@@ -1,8 +1,5 @@
-
-T7453.hs:9:15: error: [GHC-25897]
- • Couldn't match type ‘t’ with ‘p’
- Expected: Id t
- Actual: Id p
+T7453.hs:10:30: error: [GHC-25897]
+ • Couldn't match expected type ‘t’ with actual type ‘p’
‘t’ is a rigid type variable bound by
the type signature for:
z :: forall t. Id t
@@ -10,29 +7,17 @@ T7453.hs:9:15: error: [GHC-25897]
‘p’ is a rigid type variable bound by
the inferred type of cast1 :: p -> a
at T7453.hs:(7,1)-(10,30)
- • In the expression: aux
- In an equation for ‘z’:
- z = aux
- where
- aux = Id v
- In an equation for ‘cast1’:
- cast1 v
- = runId z
- where
- z :: Id t
- z = aux
- where
- aux = Id v
+ • In the first argument of ‘Id’, namely ‘v’
+ In the expression: Id v
+ In an equation for ‘aux’: aux = Id v
• Relevant bindings include
- aux :: Id p (bound at T7453.hs:10:21)
+ aux :: Id t (bound at T7453.hs:10:21)
z :: Id t (bound at T7453.hs:9:11)
v :: p (bound at T7453.hs:7:7)
cast1 :: p -> a (bound at T7453.hs:7:1)
-T7453.hs:15:15: error: [GHC-25897]
- • Couldn't match type ‘t1’ with ‘p’
- Expected: () -> t1
- Actual: () -> p
+T7453.hs:16:33: error: [GHC-25897]
+ • Couldn't match expected type ‘t1’ with actual type ‘p’
‘t1’ is a rigid type variable bound by
the type signature for:
z :: forall t1. () -> t1
@@ -40,21 +25,11 @@ T7453.hs:15:15: error: [GHC-25897]
‘p’ is a rigid type variable bound by
the inferred type of cast2 :: p -> t
at T7453.hs:(13,1)-(16,33)
- • In the expression: aux
- In an equation for ‘z’:
- z = aux
- where
- aux = const v
- In an equation for ‘cast2’:
- cast2 v
- = z ()
- where
- z :: () -> t
- z = aux
- where
- aux = const v
+ • In the first argument of ‘const’, namely ‘v’
+ In the expression: const v
+ In an equation for ‘aux’: aux = const v
• Relevant bindings include
- aux :: forall {b}. b -> p (bound at T7453.hs:16:21)
+ aux :: b -> t1 (bound at T7453.hs:16:21)
z :: () -> t1 (bound at T7453.hs:15:11)
v :: p (bound at T7453.hs:13:7)
cast2 :: p -> t (bound at T7453.hs:13:1)
@@ -86,3 +61,4 @@ T7453.hs:21:15: error: [GHC-25897]
z :: t1 (bound at T7453.hs:21:11)
v :: p (bound at T7453.hs:19:7)
cast3 :: p -> t (bound at T7453.hs:19:1)
+
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -735,3 +735,4 @@ test('T24938', normal, compile_fail, [''])
test('T25325', normal, compile_fail, [''])
test('T25004', normal, compile_fail, [''])
test('T25004k', normal, compile_fail, [''])
+test('T26004', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50b07512f0788fe9415010b1c6cddd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/50b07512f0788fe9415010b1c6cddd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
08 May '25
Bryan R pushed new branch wip/chreekat/ci-timings at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/chreekat/ci-timings
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Serge S. Gulin pushed to branch wip/T25974 at Glasgow Haskell Compiler / GHC
Commits:
d646cc97 by Serge S. Gulin at 2025-05-08T08:48:50+03:00
Test build wine!
- - - - -
3 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: 6e9f8f17086e56e83adae4a8a9d63e2fec3cb6c7
+ DOCKER_REV: 14b23867eebc6d5f43e79dab32304175e2416797
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -110,9 +110,19 @@ data Opsys
| FreeBSD14
| Windows deriving (Eq)
+data WineMode
+ = OnlyTest
+ -- ^ Wine will be used only to test binaries after cross-compile
+ -- which means we do cross-compile from Linux to Windows
+ | FullBuild
+ -- ^ Wine will be used for full process of compilation
+ -- which means compilation itself will be executed under Wine.
+ -- It makes possible to run compilation for Windows environment at Linux machines.
+ deriving (Eq)
+
data LinuxDistro
= Debian12
- | Debian12Wine
+ | Debian12Wine WineMode
| Debian12Riscv
| Debian11
| Debian11Js
@@ -316,7 +326,7 @@ distroName Debian12 = "deb12"
distroName Debian11 = "deb11"
distroName Debian11Js = "deb11-emsdk-closure"
distroName Debian12Riscv = "deb12-riscv"
-distroName Debian12Wine = "deb12-wine"
+distroName (Debian12Wine _) = "deb12-wine"
distroName Debian10 = "deb10"
distroName Debian9 = "deb9"
distroName Fedora33 = "fedora33"
@@ -360,6 +370,7 @@ testEnv arch opsys bc =
, ["no_tntc" | not (tablesNextToCode bc) ]
, ["cross_"++triple | Just triple <- pure $ crossTarget bc ]
, [flavourString (mkJobFlavour bc)]
+ , if opsys == Linux (Debian12Wine FullBuild) then ["_wine_full_build"] else []
]
-- | The hadrian flavour string we are going to use for this build
@@ -728,6 +739,7 @@ data ValidateRule
| I386Backend -- ^ Run this job when the "i386" label is set
| WinArm64 -- ^ Run this job when the "aarch64" and "Windows" labels are set together without "LLVM backend"
| WinArm64LLVM -- ^ Run this job when the "aarch64" and "Windows" labels are set together with "LLVM backend"
+ | WineArm64 -- ^ Run this job when the "aarch64" and "Wine" labels are set
deriving (Show, Ord, Eq)
-- | Convert the state of the rule into a string that gitlab understand.
@@ -781,6 +793,10 @@ validateRuleString WinArm64LLVM = and_all
, labelString "Windows"
, validateRuleString LLVMBackend
]
+validateRuleString WineArm64 = and_all
+ [ labelString "aarch64"
+ , labelString "Wine"
+ ]
---------------------------------------------------------------------
-- The Job type
@@ -847,6 +863,16 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} }
, "bash .gitlab/ci.sh build_hadrian"
, "bash .gitlab/ci.sh test_hadrian"
]
+ | Linux (Debian12Wine FullBuild) <- opsys
+ = [ "sudo chown ghc:ghc -R ."
+ , "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh setup"
+ , "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh configure"
+ -- We have to trigger cabal build in an independent way to mitigate Wine hangs at MSYS2/Arm64EC
+ , "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l -c './hadrian/build-cabal clean'"
+ , "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh build_hadrian"
+ -- It builds, it is already a huge win at the moment of this commit
+ -- TODO: , "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh test_hadrian"
+ ]
| otherwise
= [ "find libraries -name config.sub -exec cp config.sub {} \\;" | Darwin == opsys ] ++
[ "sudo chown ghc:ghc -R ." | Linux {} <- [opsys]] ++
@@ -897,6 +923,10 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} }
]
in "RUNTEST_ARGS" =: unwords runtestArgs
, if testsuiteUsePerf buildConfig then "RUNTEST_ARGS" =: "--config perf_path=perf" else mempty
+ -- TODO: move me to an appropriate way
+ , if crossTarget buildConfig == Just "aarch64-unknown-mingw32" && opsys == Linux (Debian12Wine FullBuild)
+ then "CONFIGURE_ARGS" =: "--build=x86_64-unknown-mingw32 --host=x86_64-unknown-mingw32"
+ else mempty
]
jobArtifacts = Artifacts
@@ -1277,51 +1307,73 @@ cross_jobs = [
-- Linux Aarch64 (Wine + FEX + MSYS64) => Windows Aarch64
, makeWinArmJobs
$ addValidateRule WinArm64
- (validateBuilds AArch64 (Linux Debian12Wine) winAarch64Config)
+ (validateBuilds AArch64 (Linux (Debian12Wine OnlyTest)) winAarch64Config)
, makeWinArmJobs
$ addValidateRule WinArm64LLVM
- (validateBuilds AArch64 (Linux Debian12Wine) (winAarch64Config {llvmBootstrap = True}))
+ (validateBuilds AArch64 (Linux (Debian12Wine OnlyTest)) (winAarch64Config {llvmBootstrap = True}))
+ , makeWineArmJobs
+ $ addValidateRule WineArm64
+ (validateBuilds AArch64 (Linux (Debian12Wine FullBuild)) winAarch64Config)
]
where
javascriptConfig = (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure"))
{ bignumBackend = Native }
- makeWinArmJobs = modifyJobs
- ( -- Cross compiler validate does not need any docs
- setVariable "HADRIAN_ARGS" "--docs=none"
- . setVariable "AR" (llvm_prefix ++ "llvm-ar")
- . setVariable "CC" (llvm_prefix ++ "clang")
- . setVariable "CXX" (llvm_prefix ++ "clang++")
- . setVariable "NM" (llvm_prefix ++ "nm")
- . setVariable "OBJCOPY" (llvm_prefix ++ "objcopy")
- . setVariable "OBJDUMP" (llvm_prefix ++ "objdump")
- . setVariable "RANLIB" (llvm_prefix ++ "llvm-ranlib")
- . setVariable "SIZE" (llvm_prefix ++ "size")
- . setVariable "STRINGS" (llvm_prefix ++ "strings")
- . setVariable "STRIP" (llvm_prefix ++ "strip")
- . setVariable "WindresCmd" (llvm_prefix ++ "windres")
- . setVariable "LLVMAS" (llvm_prefix ++ "clang")
- . setVariable "LD" (llvm_prefix ++ "ld")
- -- See Note [Empty MergeObjsCmd]
- -- Windows target require to make linker merge feature check disabled.
- . setVariable "MergeObjsCmd" ""
- -- Note [Wide Triple Windows]
- -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
- -- LLVM MinGW Linux Toolchain expects to recieve "aarch64-w64-mingw32"
- -- as a triple but we use more common "aarch64-unknown-mingw32".
- -- Due of this we need configure ld manually for clang because
- -- it will use system's ld otherwise when --target will be specified to
- -- unexpected triple.
- . setVariable "CFLAGS" cflags
- . setVariable "CONF_CC_OPTS_STAGE2" cflags
- ) where
- llvm_prefix = "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-"
- -- See Note [Windows Toolchain Standard Library Options]
- cflags = "-fuse-ld=" ++ llvm_prefix ++ "ld --rtlib=compiler-rt"
+ addWindowsCrossArmVars llvm_prefix exe_suffix cflags = modifyJobs
+ ( -- Cross compiler validate does not need any docs
+ setVariable "HADRIAN_ARGS" "--docs=none"
+ . setVariable "AR" (llvm_prefix ++ "llvm-ar" ++ exe_suffix)
+ . setVariable "CC" (llvm_prefix ++ "clang")
+ . setVariable "CXX" (llvm_prefix ++ "clang++")
+ . setVariable "NM" (llvm_prefix ++ "nm" ++ exe_suffix)
+ . setVariable "OBJCOPY" (llvm_prefix ++ "objcopy")
+ . setVariable "OBJDUMP" (llvm_prefix ++ "objdump")
+ . setVariable "RANLIB" (llvm_prefix ++ "llvm-ranlib" ++ exe_suffix)
+ . setVariable "SIZE" (llvm_prefix ++ "size")
+ . setVariable "STRINGS" (llvm_prefix ++ "strings")
+ . setVariable "STRIP" (llvm_prefix ++ "strip")
+ . setVariable "WindresCmd" (llvm_prefix ++ "windres")
+ . setVariable "LLVMAS" (llvm_prefix ++ "clang")
+ . setVariable "LD" (llvm_prefix ++ "ld")
+ -- See Note [Empty MergeObjsCmd]
+ -- Windows target require to make linker merge feature check disabled.
+ . setVariable "MergeObjsCmd" ""
+ -- Note [Wide Triple Windows]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ -- LLVM MinGW Linux Toolchain expects to recieve "aarch64-w64-mingw32"
+ -- as a triple but we use more common "aarch64-unknown-mingw32".
+ -- Due of this we need configure ld manually for clang because
+ -- it will use system's ld otherwise when --target will be specified to
+ -- unexpected triple.
+ . setVariable "CFLAGS" cflags
+ . setVariable "CONF_CC_OPTS_STAGE2" cflags
+ )
+
+ makeWinArmJobs =
+ let
+ llvm_prefix = "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-"
+ -- See Note [Windows Toolchain Standard Library Options]
+ cflags = "-fuse-ld=" ++ llvm_prefix ++ "ld --rtlib=compiler-rt"
+ in addWindowsCrossArmVars llvm_prefix "" cflags
winAarch64Config = (crossConfig "aarch64-unknown-mingw32" (Emulator "/opt/wine-arm64ec-msys2-deb12/bin/wine") Nothing)
{ bignumBackend = Native }
+ makeWineArmJobs =
+ let
+ llvm_path = "C:/msys64/opt/llvm-mingw-windows/bin"
+ llvm_prefix = llvm_path ++ "/aarch64-w64-mingw32-"
+ exe_suffix = ".exe"
+ -- See Note [Windows Toolchain Standard Library Options]
+ cflags = "-fuse-ld=" ++ llvm_path ++ "/bin/ld.lld --rtlib=compiler-rt -D_UCRT"
+ in modifyJobs
+ ( setVariable "TOOLCHAIN_SOURCE" "env"
+ . setVariable "DLLTOOL" (llvm_path ++ "/dlltool" ++ exe_suffix)
+ . setVariable "CC_STAGE0" (llvm_path ++ "/bin/x86_64-w64-mingw32-clang")
+ . setVariable "CONF_CC_OPTS_STAGE0" ("--target=x86_64-unknown-mingw32 " ++ cflags)
+ . setVariable "CONF_CC_OPTS_STAGE1" cflags
+ ) . (addWindowsCrossArmVars llvm_prefix exe_suffix cflags)
+
make_wasm_jobs cfg =
modifyJobs
( -- See Note [Testing wasm ghci browser mode]
@@ -1381,6 +1433,7 @@ platform_mapping = Map.map go combined_result
, "x86_64-windows-validate"
, "aarch64-linux-deb12-validate"
, "aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate"
+ , "aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build"
, "nightly-x86_64-linux-alpine3_20-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf"
, "nightly-x86_64-linux-deb11-validate"
, "nightly-x86_64-linux-deb12-validate"
@@ -1389,6 +1442,7 @@ platform_mapping = Map.map go combined_result
, "nightly-aarch64-linux-deb10-validate"
, "nightly-aarch64-linux-deb12-validate"
, "nightly-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate"
+ , "nightly-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build"
, "nightly-x86_64-linux-alpine3_12-validate"
, "nightly-x86_64-linux-deb10-validate"
, "nightly-x86_64-linux-fedora33-release"
=====================================
.gitlab/jobs.yaml
=====================================
@@ -477,6 +477,92 @@
"WindresCmd": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-windres"
}
},
+ "aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh save_test_output",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "2 weeks",
+ "paths": [
+ "ghc-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build.tar.xz",
+ "junit.xml",
+ "unexpected-test-output.tar.gz"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "aarch64-linux-deb12-wine-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb12-wine:$DOCKER_…",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\baarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || (($CI_MERGE_REQUEST_LABELS =~ /.*aarch64.*/) && ($CI_MERGE_REQUEST_LABELS =~ /.*Wine.*/))))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh setup",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh configure",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l -c './hadrian/build-cabal clean'",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh build_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "aarch64-linux"
+ ],
+ "variables": {
+ "AR": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-llvm-ar.exe",
+ "BIGNUM_BACKEND": "native",
+ "BIN_DIST_NAME": "ghc-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build",
+ "BUILD_FLAVOUR": "validate",
+ "CC": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang",
+ "CC_STAGE0": "C:/msys64/opt/llvm-mingw-windows/bin/bin/x86_64-w64-mingw32-clang",
+ "CFLAGS": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check --build=x86_64-unknown-mingw32 --host=x86_64-unknown-mingw32",
+ "CONF_CC_OPTS_STAGE0": "--target=x86_64-unknown-mingw32 -fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONF_CC_OPTS_STAGE1": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONF_CC_OPTS_STAGE2": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine",
+ "CROSS_TARGET": "aarch64-unknown-mingw32",
+ "CXX": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang++",
+ "DLLTOOL": "C:/msys64/opt/llvm-mingw-windows/bin/dlltool.exe",
+ "HADRIAN_ARGS": "--docs=none",
+ "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "LD": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-ld",
+ "LLVMAS": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang",
+ "MergeObjsCmd": "",
+ "NM": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-nm.exe",
+ "OBJCOPY": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-objcopy",
+ "OBJDUMP": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-objdump",
+ "RANLIB": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-llvm-ranlib.exe",
+ "RUNTEST_ARGS": "",
+ "SIZE": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-size",
+ "STRINGS": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-strings",
+ "STRIP": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-strip",
+ "TEST_ENV": "aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build",
+ "TOOLCHAIN_SOURCE": "env",
+ "WindresCmd": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-windres"
+ }
+ },
"i386-linux-alpine3_20-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -1148,6 +1234,93 @@
"XZ_OPT": "-9"
}
},
+ "nightly-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh save_test_output",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "8 weeks",
+ "paths": [
+ "ghc-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build.tar.xz",
+ "junit.xml",
+ "unexpected-test-output.tar.gz"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "aarch64-linux-deb12-wine-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb12-wine:$DOCKER_…",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh setup",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh configure",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l -c './hadrian/build-cabal clean'",
+ "/opt/wine-arm64ec-msys2-deb12/bin/wine c:/msys64/usr/bin/bash.exe -l .gitlab/ci.sh build_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "aarch64-linux"
+ ],
+ "variables": {
+ "AR": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-llvm-ar.exe",
+ "BIGNUM_BACKEND": "native",
+ "BIN_DIST_NAME": "ghc-aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build",
+ "BUILD_FLAVOUR": "validate",
+ "CC": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang",
+ "CC_STAGE0": "C:/msys64/opt/llvm-mingw-windows/bin/bin/x86_64-w64-mingw32-clang",
+ "CFLAGS": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check --build=x86_64-unknown-mingw32 --host=x86_64-unknown-mingw32",
+ "CONF_CC_OPTS_STAGE0": "--target=x86_64-unknown-mingw32 -fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONF_CC_OPTS_STAGE1": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CONF_CC_OPTS_STAGE2": "-fuse-ld=C:/msys64/opt/llvm-mingw-windows/bin/bin/ld.lld --rtlib=compiler-rt -D_UCRT",
+ "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine",
+ "CROSS_TARGET": "aarch64-unknown-mingw32",
+ "CXX": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang++",
+ "DLLTOOL": "C:/msys64/opt/llvm-mingw-windows/bin/dlltool.exe",
+ "HADRIAN_ARGS": "--docs=none",
+ "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "LD": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-ld",
+ "LLVMAS": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-clang",
+ "MergeObjsCmd": "",
+ "NM": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-nm.exe",
+ "OBJCOPY": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-objcopy",
+ "OBJDUMP": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-objdump",
+ "RANLIB": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-llvm-ranlib.exe",
+ "RUNTEST_ARGS": "",
+ "SIZE": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-size",
+ "STRINGS": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-strings",
+ "STRIP": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-strip",
+ "TEST_ENV": "aarch64-linux-deb12-wine-int_native-cross_aarch64-unknown-mingw32-validate-_wine_full_build",
+ "TOOLCHAIN_SOURCE": "env",
+ "WindresCmd": "C:/msys64/opt/llvm-mingw-windows/bin/aarch64-w64-mingw32-windres",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-i386-linux-alpine3_20-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d646cc9717c96a72d89adc8fe74cae6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d646cc9717c96a72d89adc8fe74cae6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: llvmGen: Fix built-in variable predicate
by Marge Bot (＠marge-bot) 08 May '25
by Marge Bot (＠marge-bot) 08 May '25
08 May '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
350d26d2 by Ben Gamari at 2025-05-08T00:10:36-04:00
llvmGen: Fix built-in variable predicate
Previously the predicate to identify LLVM builtin global variables was
checking for `$llvm` rather than `@llvm` as it should.
- - - - -
43396402 by Ben Gamari at 2025-05-08T00:10:36-04:00
llvmGen: Fix linkage of built-in arrays
LLVM now insists that built-in arrays use Appending linkage, not
Internal.
Fixes #25769.
- - - - -
4dbf5b41 by sheaf at 2025-05-08T00:10:41-04:00
Use mkTrAppChecked in ds_ev_typeable
This change avoids violating the invariant of mkTrApp according to which
the argument should not be a fully saturated function type.
This ensures we don't return false negatives for type equality
involving function types.
Fixes #25998
- - - - -
0c7147d2 by Ryan Hendrickson at 2025-05-08T00:10:45-04:00
haddock: Preserve indentation in multiline examples
Intended for use with :{ :}, but doesn't look for those characters. Any
consecutive lines with birdtracks will only have initial whitespace
stripped up to the column of the first line.
- - - - -
3b5267fd by Cheng Shao at 2025-05-08T00:10:46-04:00
ci: re-enable chrome for wasm ghci browser tests
Currently only firefox is enabled for wasm ghci browser tests, for
some reason testing with chrome works on my machine but gets stuck on
gitlab instance runners. This patch re-enables testing with chrome by
passing `--no-sandbox`, since chrome sandboxing doesn't work in
containers without `--cap-add=SYS_ADMIN`.
- - - - -
11 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/HsToCore/Binds.hs
- + testsuite/tests/typecheck/should_run/T25998.hs
- + testsuite/tests/typecheck/should_run/T25998.stdout
- testsuite/tests/typecheck/should_run/all.T
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -1322,6 +1322,7 @@ cross_jobs = [
modifyJobs
( -- See Note [Testing wasm ghci browser mode]
setVariable "FIREFOX_LAUNCH_OPTS" "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}"
+ . setVariable "CHROME_LAUNCH_OPTS" "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}"
. setVariable "HADRIAN_ARGS" "--docs=no-sphinx-pdfs --docs=no-sphinx-man"
. delVariable "INSTALL_CONFIGURE_ARGS"
)
=====================================
.gitlab/jobs.yaml
=====================================
@@ -1786,6 +1786,7 @@
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -1851,6 +1852,7 @@
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -1916,6 +1918,7 @@
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6031,6 +6034,7 @@
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6096,6 +6100,7 @@
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
@@ -6161,6 +6166,7 @@
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_20-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf",
"BUILD_FLAVOUR": "release+host_fully_static+text_simdutf",
+ "CHROME_LAUNCH_OPTS": "{\"browser\":\"chrome\",\"protocol\":\"webDriverBiDi\",\"executablePath\":\"/usr/bin/chromium\",\"args\":[\"--no-sandbox\"]}",
"CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check",
"CROSS_TARGET": "wasm32-wasi",
"FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}",
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -245,7 +245,7 @@ basicKnownKeyNames
typeRepIdName,
mkTrTypeName,
mkTrConName,
- mkTrAppName,
+ mkTrAppCheckedName,
mkTrFunName,
typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
trGhcPrimModuleName,
@@ -1356,7 +1356,7 @@ typeableClassName
, someTypeRepDataConName
, mkTrTypeName
, mkTrConName
- , mkTrAppName
+ , mkTrAppCheckedName
, mkTrFunName
, typeRepIdName
, typeNatTypeRepName
@@ -1371,7 +1371,7 @@ someTypeRepDataConName = dcQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "SomeTypeR
typeRepIdName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
mkTrTypeName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey
mkTrConName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
-mkTrAppName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey
+mkTrAppCheckedName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrAppChecked") mkTrAppCheckedKey
mkTrFunName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
typeNatTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
typeSymbolTypeRepName = varQual gHC_INTERNAL_TYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
@@ -2499,7 +2499,7 @@ proxyHashKey = mkPreludeMiscIdUnique 502
mkTyConKey
, mkTrTypeKey
, mkTrConKey
- , mkTrAppKey
+ , mkTrAppCheckedKey
, mkTrFunKey
, typeNatTypeRepKey
, typeSymbolTypeRepKey
@@ -2509,7 +2509,7 @@ mkTyConKey
mkTyConKey = mkPreludeMiscIdUnique 503
mkTrTypeKey = mkPreludeMiscIdUnique 504
mkTrConKey = mkPreludeMiscIdUnique 505
-mkTrAppKey = mkPreludeMiscIdUnique 506
+mkTrAppCheckedKey = mkPreludeMiscIdUnique 506
typeNatTypeRepKey = mkPreludeMiscIdUnique 507
typeSymbolTypeRepKey = mkPreludeMiscIdUnique 508
typeCharTypeRepKey = mkPreludeMiscIdUnique 509
=====================================
compiler/GHC/CmmToLlvm/Base.hs
=====================================
@@ -526,10 +526,10 @@ generateExternDecls = do
modifyEnv $ \env -> env { envAliases = emptyUniqSet }
return (concat defss, [])
--- | Is a variable one of the special @$llvm@ globals?
+-- | Is a variable one of the special @\@llvm@ globals?
isBuiltinLlvmVar :: LlvmVar -> Bool
isBuiltinLlvmVar (LMGlobalVar lbl _ _ _ _ _) =
- "$llvm" `isPrefixOf` unpackFS lbl
+ "llvm." `isPrefixOf` unpackFS lbl
isBuiltinLlvmVar _ = False
-- | Here we take a global variable definition, rename it with a
=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -125,7 +125,7 @@ genGlobalLabelArray var_nm clbls = do
prio = LMStaticLit $ LMIntLit 0xffff i32
in LMStaticStrucU [prio, fn, null] entry_ty
- arr_var = LMGlobalVar var_nm arr_ty Internal Nothing Nothing Global
+ arr_var = LMGlobalVar var_nm arr_ty Appending Nothing Nothing Global
mkFunTy lbl = LMFunction $ LlvmFunctionDecl lbl ExternallyVisible CC_Ccc LMVoid FixedArgs [] Nothing
entry_ty = LMStructU [i32, LMPointer $ mkFunTy $ fsLit "placeholder", LMPointer i8]
arr_ty = LMArray (length clbls) entry_ty
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -1850,14 +1850,14 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
| Just (t1,t2) <- splitAppTy_maybe ty
= do { e1 <- getRep ev1 t1
; e2 <- getRep ev2 t2
- ; mkTrApp <- dsLookupGlobalId mkTrAppName
- -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
- -- TypeRep a -> TypeRep b -> TypeRep (a b)
+ ; mkTrAppChecked <- dsLookupGlobalId mkTrAppCheckedName
+ -- mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
+ -- TypeRep a -> TypeRep b -> TypeRep (a b)
; let (_, k1, k2) = splitFunTy (typeKind t1) -- drop the multiplicity,
-- since it's a kind
- ; let expr = mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
+ ; let expr = mkApps (mkTyApps (Var mkTrAppChecked) [ k1, k2, t1, t2 ])
[ e1, e2 ]
- -- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
+ -- ; pprRuntimeTrace "Trace mkTrAppChecked" (ppr expr) expr
; return expr
}
=====================================
testsuite/tests/typecheck/should_run/T25998.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Data.Kind
+import Type.Reflection
+
+test :: forall (a :: Type) (b :: Type). TypeRep a -> TypeRep b -> String
+test a b = case eqTypeRep a b of
+ Just _ -> "Equal!\n"
+ Nothing -> "Not equal:\n" <> show a <> "\n" <> show b <> "\n"
+
+combine :: forall (t :: Type -> Type -> Type). Typeable t => TypeRep (t Bool Int)
+combine = typeRep
+
+main :: IO ()
+main = do
+ putStrLn $ test (typeRep @(Bool -> Int)) (combine @(->))
=====================================
testsuite/tests/typecheck/should_run/T25998.stdout
=====================================
@@ -0,0 +1,2 @@
+Equal!
+
=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -173,6 +173,7 @@ test('T23761', normal, compile_and_run, [''])
test('T25529', normal, compile_and_run, [''])
test('T23761b', normal, compile_and_run, [''])
test('T17594e', normal, compile_and_run, [''])
+test('T25998', normal, compile_and_run, [''])
# Tests for expanding do before typechecking (Impredicative + RebindableSyntax)
test('T18324', normal, compile_and_run, [''])
=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
=====================================
@@ -795,31 +795,33 @@ stripSpace = fromMaybe <*> mapM strip'
-- | Parses examples. Examples are a paragraph level entity (separated by an empty line).
-- Consecutive examples are accepted.
examples :: Parser (DocH mod a)
-examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)
+examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go Nothing)
where
- go :: Parser [Example]
- go = do
+ go :: Maybe Text -> Parser [Example]
+ go mbInitialIndent = do
prefix <- takeHorizontalSpace <* ">>>"
+ initialIndent <- maybe takeHorizontalSpace pure mbInitialIndent
expr <- takeLine
- (rs, es) <- resultAndMoreExamples
- return (makeExample prefix expr rs : es)
+ (rs, es) <- resultAndMoreExamples (Just initialIndent)
+ return (makeExample prefix initialIndent expr rs : es)
+
+ resultAndMoreExamples :: Maybe Text -> Parser ([Text], [Example])
+ resultAndMoreExamples mbInitialIndent = choice' [moreExamples, result, pure ([], [])]
where
- resultAndMoreExamples :: Parser ([Text], [Example])
- resultAndMoreExamples = choice' [moreExamples, result, pure ([], [])]
- where
- moreExamples :: Parser ([Text], [Example])
- moreExamples = (,) [] <$> go
+ moreExamples :: Parser ([Text], [Example])
+ moreExamples = (,) [] <$> go mbInitialIndent
- result :: Parser ([Text], [Example])
- result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples
+ result :: Parser ([Text], [Example])
+ result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples Nothing
- makeExample :: Text -> Text -> [Text] -> Example
- makeExample prefix expression res =
- Example (T.unpack (T.strip expression)) result
+ makeExample :: Text -> Text -> Text -> [Text] -> Example
+ makeExample prefix indent expression res =
+ Example (T.unpack (tryStripIndent (T.stripEnd expression))) result
where
result = map (T.unpack . substituteBlankLine . tryStripPrefix) res
tryStripPrefix xs = fromMaybe xs (T.stripPrefix prefix xs)
+ tryStripIndent = liftA2 fromMaybe T.stripStart (T.stripPrefix indent)
substituteBlankLine "<BLANKLINE>" = ""
substituteBlankLine xs = xs
=====================================
utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs
=====================================
@@ -864,6 +864,29 @@ spec = do
it "accepts unicode in examples" $ do
">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]]
+ it "preserves indentation in consecutive example lines" $ do
+ unlines
+ [ ">>> line 1"
+ , ">>> line 2"
+ , ">>> line 3"
+ ]
+ `shouldParseTo` DocExamples
+ [ Example "line 1" []
+ , Example " line 2" []
+ , Example "line 3" []
+ ]
+
+ it "resets indentation after results" $ do
+ unlines
+ [ ">>> line 1"
+ , "result"
+ , ">>> line 2"
+ ]
+ `shouldParseTo` DocExamples
+ [ Example "line 1" ["result"]
+ , Example "line 2" []
+ ]
+
context "when prompt is prefixed by whitespace" $ do
it "strips the exact same amount of whitespace from result lines" $ do
unlines
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6836f724f2b10bb2d527f6ca026cb2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6836f724f2b10bb2d527f6ca026cb2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/enforce-namespaces] refactor: mkSubordinateError
by Vladislav Zavialov (＠int-index) 07 May '25
by Vladislav Zavialov (＠int-index) 07 May '25
07 May '25
Vladislav Zavialov pushed to branch wip/int-index/enforce-namespaces at Glasgow Haskell Compiler / GHC
Commits:
97ed302a by Vladislav Zavialov at 2025-05-08T02:28:13+03:00
refactor: mkSubordinateError
- - - - -
1 changed file:
- compiler/GHC/Rename/Names.hs
Changes:
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1382,16 +1382,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-- to find 'b' and 'd'. So we make up an import item
-- to report as failing, namely T( b, d ).
-- c.f. #15413
- subordinate_err =
- assertPpr (length unavailable + length nontype == length items)
- (ppr items) $
- IsSubordinateError { subordinate_err_parent = gre
- , subordinate_err_unavailable = unavailable
- , subordinate_err_nontype = nontype }
- unavailable =
- [ (occNameFS . rdrNameOcc . ieWrappedName) wname
- | LookupChildNotFound (L _ wname) <- children_errs ]
- nontype = [ g | LookupChildNonType{lce_nontype_item = g} <- children_errs ]
+ subordinate_err = mkSubordinateError gre children_errs
in bad_import_w ie subordinate_err
let name' = replaceWrappedName rdr_tc name
@@ -1447,6 +1438,22 @@ data IsSubordinateError
, subordinate_err_nontype :: [GlobalRdrElt] }
| IsNotSubordinate
+mkSubordinateError :: GlobalRdrElt -> [LookupChildError] -> IsSubordinateError
+mkSubordinateError gre children_errs = foldr add init_acc children_errs
+ where
+ init_acc :: IsSubordinateError
+ init_acc = IsSubordinateError gre [] []
+
+ add :: LookupChildError -> IsSubordinateError -> IsSubordinateError
+ add children_err sub@IsSubordinateError{} =
+ case children_err of
+ LookupChildNonType{lce_nontype_item = g} ->
+ sub { subordinate_err_nontype = g : subordinate_err_nontype sub }
+ LookupChildNotFound (L _ wname) ->
+ let fs = (occNameFS . rdrNameOcc . ieWrappedName) wname
+ in sub { subordinate_err_unavailable = fs : subordinate_err_unavailable sub }
+ add _ IsNotSubordinate = panic "mkSubordinateError: IsNotSubordinate"
+
data IELookupError
= QualImportError RdrName
| BadImport (IE GhcPs) IsSubordinateError
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97ed302a40d8362975c7703d4e402bf…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/97ed302a40d8362975c7703d4e402bf…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/enforce-namespaces] formatting
by Vladislav Zavialov (＠int-index) 07 May '25
by Vladislav Zavialov (＠int-index) 07 May '25
07 May '25
Vladislav Zavialov pushed to branch wip/int-index/enforce-namespaces at Glasgow Haskell Compiler / GHC
Commits:
14eaf5e4 by Vladislav Zavialov at 2025-05-08T02:00:49+03:00
formatting
- - - - -
1 changed file:
- compiler/GHC/Tc/Errors/Ppr.hs
Changes:
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -5912,7 +5912,7 @@ pprImportLookup = \case
BadImportNonTypeSubordinates gre nontype1 ->
withContext
[ what <+> text "called" <+> parent_name <+> text "is exported,"
- , sep [ text "but its subordinate" <+> "item" <> plural nontype <+> nontype_names
+ , sep [ text "but its subordinate item" <> plural nontype <+> nontype_names
, isOrAre nontype <+> "not in the type namespace." ] ]
where
nontype = NE.toList nontype1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14eaf5e44be16b040a9200e0d48c640…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14eaf5e44be16b040a9200e0d48c640…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T25992] WIP on unsued constraints [skip ci]
by Simon Peyton Jones (＠simonpj) 07 May '25
by Simon Peyton Jones (＠simonpj) 07 May '25
07 May '25
Simon Peyton Jones pushed to branch wip/T25992 at Glasgow Haskell Compiler / GHC
Commits:
379158f7 by Simon Peyton Jones at 2025-05-07T23:36:44+01:00
WIP on unsued constraints [skip ci]
- - - - -
1 changed file:
- compiler/GHC/Tc/Solver/Solve.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -51,9 +51,10 @@ import GHC.Utils.Misc
import GHC.Driver.Session
-import Data.List( deleteFirstsBy )
import Control.Monad
+
+import Data.List( deleteFirstsBy )
import Data.Foldable ( traverse_ )
import Data.Maybe ( mapMaybe )
import qualified Data.Semigroup as S
@@ -551,14 +552,18 @@ neededEvVars implic@(Implic { ic_given = givens
= do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var
; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
- ; let seeds1 = foldr add_implic_seeds old_needs implics
- seeds2 = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds
- -- It's OK to use a non-deterministic fold here
- -- because add_wanted is commutative
- seeds3 = seeds2 `unionVarSet` tcvs
- need_inner = findNeededEvVars ev_binds seeds3
- live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds
- need_outer = varSetMinusEvBindMap need_inner live_ev_binds
+ ; let seeds_i = get_implic_needs normal_implics
+ seeds_w = nonDetStrictFoldEvBindMap add_wanted emptyVarSet ev_binds
+ -- It's OK to use a non-deterministic fold here
+ -- because add_wanted is commutative
+ all_seeds = old_needs `unionVarSet` seeds_i `unionVarSet` seeds_w `unionVarSet` tcvs
+
+ need_inner_ignoring_dms = findNeededEvVars ev_binds all_seeds
+ need_inner_from_dms = findNeededEvVars ev_binds (get_implic_needs dm_implics)
+ need_inner_full = need_inner_ignoring_dms `unionVarSet` need_inner_from_dms
+ live_ev_binds = filterEvBindMap (needed_ev_bind need_inner_full) ev_binds
+
+ need_outer = varSetMinusEvBindMap need_inner_full live_ev_binds
`delVarSetList` givens
; TcS.setTcEvBindsMap ev_binds_var live_ev_binds
@@ -566,23 +571,26 @@ neededEvVars implic@(Implic { ic_given = givens
; traceTcS "neededEvVars" $
vcat [ text "old_needs:" <+> ppr old_needs
- , text "seeds3:" <+> ppr seeds3
+ , text "all_seeds:" <+> ppr all_seeds
, text "tcvs:" <+> ppr tcvs
, text "ev_binds:" <+> ppr ev_binds
, text "live_ev_binds:" <+> ppr live_ev_binds ]
- ; return (implic { ic_need_inner = need_inner
+ ; return (implic { ic_need_inner = need_inner_ignoring_dms
, ic_need_outer = need_outer }) }
where
- add_implic_seeds (Implic { ic_need_outer = needs, ic_info = skol_info }) acc
- | MethSkol _ is_dm <- skol_info
- , is_dm -- See Note [Ignore 'needs' from default methods]
- = acc
- | otherwise
+ (dm_implics, normal_implics) = partitionBag is_dm_implic implics
+ -- dm_implics is usually empty
+
+ is_dm_implic (Implic { ic_info = skol_info })
+ | MethSkol _ is_dm <- skol_info = is_dm
+ | otherwise = False
+
+ get_implic_needs = foldr add_implic_seeds emptyVarSet
+ add_implic_seeds (Implic { ic_need_outer = needs }) acc
= needs `unionVarSet` acc
- needed_ev_bind needed (EvBind { eb_lhs = ev_var
- , eb_info = info })
+ needed_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info })
| EvBindGiven{} <- info = ev_var `elemVarSet` needed
| otherwise = True -- Keep all wanted bindings
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379158f739fc50273fdf96c0f6bfdeb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379158f739fc50273fdf96c0f6bfdeb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/enforce-namespaces] use NonEmpty, add comments, test cases
by Vladislav Zavialov (＠int-index) 07 May '25
by Vladislav Zavialov (＠int-index) 07 May '25
07 May '25
Vladislav Zavialov pushed to branch wip/int-index/enforce-namespaces at Glasgow Haskell Compiler / GHC
Commits:
b313d5f4 by Vladislav Zavialov at 2025-05-08T01:34:50+03:00
use NonEmpty, add comments, test cases
- - - - -
20 changed files:
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- + testsuite/tests/rename/should_compile/T25983a.hs
- testsuite/tests/rename/should_compile/T25983.stderr → testsuite/tests/rename/should_compile/T25983a.stderr
- + testsuite/tests/rename/should_compile/T25983b.hs
- + testsuite/tests/rename/should_compile/T25983b.stderr
- + testsuite/tests/rename/should_compile/T25983c.hs
- + testsuite/tests/rename/should_compile/T25983c.stderr
- testsuite/tests/rename/should_compile/T25983.hs → testsuite/tests/rename/should_compile/T25983d.hs
- + testsuite/tests/rename/should_compile/T25983d.stderr
- + testsuite/tests/rename/should_compile/T25983e.hs
- + testsuite/tests/rename/should_compile/T25983e.stderr
- + testsuite/tests/rename/should_compile/T25983f.hs
- + testsuite/tests/rename/should_compile/T25983f.stderr
- + testsuite/tests/rename/should_compile/T25983g.hs
- + testsuite/tests/rename/should_compile/T25983g.stderr
- testsuite/tests/rename/should_compile/T25984a.stderr
- testsuite/tests/rename/should_compile/all.T
- testsuite/tests/rename/should_fail/T9006.stderr
Changes:
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1268,7 +1268,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
warning_msg (BadImportW ie sub) = do
-- 'BadImportW' is only constructed below in 'bad_import_w', in
-- the 'EverythingBut' case, so here we assume a 'hiding' clause.
- (reason : _) <- badImportItemErr iface decl_spec ie sub all_avails
+ (reason :| _) <- badImportItemErr iface decl_spec ie sub all_avails
pure (TcRnDodgyImports (DodgyImportsHiding reason))
warning_msg (DeprecatedExport n w) =
pure $ TcRnPragmaWarning
@@ -1281,14 +1281,14 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
run_lookup def m = case m of
Failed err -> do
msgs <- lookup_err_msgs err
- mapM_ addErr [TcRnImportLookup msg | msg <- msgs]
+ forM_ msgs $ \msg -> addErr (TcRnImportLookup msg)
return def
Succeeded a -> return a
lookup_err_msgs err = case err of
BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails
- IllegalImport -> pure [ImportLookupIllegal]
- QualImportError rdr -> pure [ImportLookupQualified rdr]
+ IllegalImport -> pure $ NE.singleton ImportLookupIllegal
+ QualImportError rdr -> pure $ NE.singleton (ImportLookupQualified rdr)
-- For each import item, we convert its RdrNames to Names,
-- and at the same time compute all the GlobalRdrElt corresponding
@@ -1642,7 +1642,7 @@ lookupChildren :: [GlobalRdrElt]
-> ( [LookupChildError] -- The ones for which the lookup failed
, [LocatedA GlobalRdrElt] )
-- (lookupChildren all_kids rdr_items) maps each rdr_item to its
--- corresponding Name all_kids, if the former exists
+-- corresponding Name in all_kids, if the former exists
-- The matching is done by FastString, not OccName, so that
-- Cls( meth, AssocTy )
-- will correctly find AssocTy among the all_kids of Cls, even though
@@ -1652,20 +1652,34 @@ lookupChildren all_kids rdr_items = (fails, successes)
where
mb_xs = map do_one rdr_items
fails = [ err | Failed err <- mb_xs ]
- successes = [ ok | Succeeded oks <- mb_xs, ok <- oks ]
+ successes = [ ok | Succeeded oks <- mb_xs, ok <- NE.toList oks ]
- do_one :: LIEWrappedName GhcPs -> MaybeErr LookupChildError [LocatedA GlobalRdrElt]
+ do_one :: LIEWrappedName GhcPs -> MaybeErr LookupChildError (NonEmpty (LocatedA GlobalRdrElt))
do_one item@(L l r) =
case r of
- IEName{} | notNull val_gs -> Succeeded [L l g | g <- val_gs]
- IEName{} | notNull typ_gs -> Succeeded [L l g | g <- typ_gs]
- IEType{} | notNull typ_gs -> Succeeded [L l g | g <- typ_gs]
- IEType{} | (g:_) <- val_gs -> Failed $ LookupChildNonType item g
- _ -> Failed $ LookupChildNotFound item
+ IEName{}
+ -- IEName (unadorned name) places no restriction on the namespace of
+ -- the imported entity, so we look in both `val_gres` and `typ_gres`.
+ -- In case of conflict (punning), the value namespace takes priority.
+ -- See Note [Prioritise the value namespace in subordinate import lists]
+ | (gre:gres) <- val_gres -> Succeeded $ fmap (L l) (gre:|gres)
+ | (gre:gres) <- typ_gres -> Succeeded $ fmap (L l) (gre:|gres)
+ | otherwise -> Failed $ LookupChildNotFound item
+
+ IEType{}
+ -- IEType ('type' namespace specifier) restricts the lookup to the
+ -- type namespace, i.e. to `typ_gres`. In case of failure, we check
+ -- `val_gres` to produce a more helpful error message.
+ | (gre:gres) <- typ_gres -> Succeeded $ fmap (L l) (gre:|gres)
+ | (gre:_) <- val_gres -> Failed $ LookupChildNonType item gre
+ | otherwise -> Failed $ LookupChildNotFound item
+
+ IEPattern{} -> panic "lookupChildren: IEPattern" -- Never happens (invalid syntax)
+ IEDefault{} -> panic "lookupChildren: IEDefault" -- Never happens (invalid syntax)
where
fs = (occNameFS . rdrNameOcc . ieWrappedName) r
- gs = fromMaybe [] (lookupFsEnv kid_env fs)
- (val_gs, typ_gs) = partition (isValNameSpace . greNameSpace) gs
+ gres = fromMaybe [] (lookupFsEnv kid_env fs)
+ (val_gres, typ_gres) = partition (isValNameSpace . greNameSpace) gres
-- See Note [Children for duplicate record fields]
kid_env :: FastStringEnv [GlobalRdrElt]
@@ -1673,6 +1687,38 @@ lookupChildren all_kids rdr_items = (fails, successes)
[(occNameFS (occName x), [x]) | x <- all_kids]
+{- Note [Prioritise the value namespace in subordinate import lists]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this program that defines a class that has both an associated type
+named (#) and a method named (#)
+
+ module M_assoc where
+ class C a b where
+ type a # b
+ (#) :: a -> b -> ()
+ module N_assoc where
+ import M_assoc( C((#)) )
+
+In the import declaration, when we see the unadorned name (#) in the subordinate
+import list of C, which children should we bring into scope? Our options are:
+
+ a) only the method (#)
+ b) only the associated type (#)
+ c) both the method and the associated type
+
+To follow the precedent established by top-level items, we go with option (a).
+Indeed, consider a slightly different program
+
+ module M_top where
+ type family a # b
+ a # b = ()
+ module N_top where
+ import M_top( (#) )
+
+Here the import brings only the function (#) into scope, and one has to say
+`type (#)` to get the type family.
+-}
+
-------------------------------
{-
@@ -2331,27 +2377,31 @@ badImportItemErr
:: ModIface -> ImpDeclSpec -> IE GhcPs
-> IsSubordinateError
-> [AvailInfo]
- -> TcRn [ImportLookupReason] -- non-empty
+ -> TcRn (NonEmpty ImportLookupReason)
badImportItemErr iface decl_spec ie sub avails = do
patsyns_enabled <- xoptM LangExt.PatternSynonyms
expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces
+ let import_lookup_bad :: BadImportKind -> ImportLookupReason
+ import_lookup_bad k = ImportLookupBad k iface decl_spec ie patsyns_enabled
dflags <- getDynFlags
hsc_env <- getTopEnv
let rdr_env = mkGlobalRdrEnv
$ gresFromAvails hsc_env (Just imp_spec) all_avails
- pure [ImportLookupBad k iface decl_spec ie patsyns_enabled | k <- importErrorKind dflags rdr_env expl_ns_enabled ]
+ pure $ fmap import_lookup_bad (importErrorKind dflags rdr_env expl_ns_enabled)
where
+ importErrorKind :: DynFlags -> GlobalRdrEnv -> Bool -> NonEmpty BadImportKind
importErrorKind dflags rdr_env expl_ns_enabled
| any checkIfTyCon avails = case sub of
- IsNotSubordinate -> [BadImportAvailTyCon expl_ns_enabled]
+ IsNotSubordinate -> NE.singleton (BadImportAvailTyCon expl_ns_enabled)
IsSubordinateError { subordinate_err_parent = gre
, subordinate_err_unavailable = unavailable
, subordinate_err_nontype = nontype }
- -> [BadImportNotExportedSubordinates gre unavailable | notNull unavailable] ++
- [BadImportNonTypeSubordinates gre nontype | notNull nontype ]
- | any checkIfVarName avails = [BadImportAvailVar]
- | Just con <- find checkIfDataCon avails = [BadImportAvailDataCon (availOccName con)]
- | otherwise = [BadImportNotExported suggs]
+ -> NE.fromList $ catMaybes $
+ [ fmap (BadImportNotExportedSubordinates gre) (NE.nonEmpty unavailable)
+ , fmap (BadImportNonTypeSubordinates gre) (NE.nonEmpty nontype) ]
+ | any checkIfVarName avails = NE.singleton BadImportAvailVar
+ | Just con <- find checkIfDataCon avails = NE.singleton (BadImportAvailDataCon (availOccName con))
+ | otherwise = NE.singleton (BadImportNotExported suggs)
where
suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr
what_look = case sub of
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -119,6 +119,7 @@ import GHC.Data.List.SetOps ( nubOrdBy )
import GHC.Data.Maybe
import GHC.Data.Pair
import GHC.Settings.Constants (mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE)
+import GHC.Utils.Lexeme
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -5886,24 +5887,35 @@ pprImportLookup = \case
where
tycon_occ = rdrNameOcc $ ieName ie
tycon = parenSymOcc tycon_occ (ppr tycon_occ)
- BadImportNotExportedSubordinates gre unavailable ->
+ BadImportNotExportedSubordinates gre unavailable1 ->
withContext
[ what <+> text "called" <+> parent_name <+> text "is exported, but it does not export"
, text "any" <+> what_children <+> text "called" <+> unavailable_names <> dot
]
where
+ unavailable = NE.toList unavailable1
parent_name = (quotes . pprPrefixOcc . nameOccName . gre_name) gre
unavailable_names = pprWithCommas (quotes . ppr) unavailable
- (what, what_children) = case greInfo gre of
- IAmTyCon ClassFlavour -> (text "a class", text "class methods or associated types")
- IAmTyCon _ -> (text "a data type", text "constructors or record fields")
- _ -> (text "an item", text "children")
- BadImportNonTypeSubordinates gre nontype ->
+ any_names p = any (p . unpackFS) unavailable
+ what = case greInfo gre of
+ IAmTyCon ClassFlavour -> text "a class"
+ IAmTyCon _ -> text "a data type"
+ _ -> text "an item"
+ what_children = unquotedListWith "or" $ case greInfo gre of
+ IAmTyCon ClassFlavour ->
+ [text "class methods" | any_names okVarOcc ] ++
+ [text "associated types" | any_names okTcOcc ]
+ IAmTyCon _ ->
+ [text "constructors" | any_names okConOcc ] ++
+ [text "record fields" | any_names okVarOcc ]
+ _ -> [text "children"]
+ BadImportNonTypeSubordinates gre nontype1 ->
withContext
[ what <+> text "called" <+> parent_name <+> text "is exported,"
, sep [ text "but its subordinate" <+> "item" <> plural nontype <+> nontype_names
, isOrAre nontype <+> "not in the type namespace." ] ]
where
+ nontype = NE.toList nontype1
parent_name = (quotes . pprPrefixOcc . nameOccName . gre_name) gre
nontype_names = pprWithCommas (quotes . pprPrefixOcc . nameOccName . gre_name) nontype
what = case greInfo gre of
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -5837,9 +5837,9 @@ data BadImportKind
-- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@
| BadImportAvailDataCon OccName
-- | The parent does not export the given children.
- | BadImportNotExportedSubordinates !GlobalRdrElt [FastString]
+ | BadImportNotExportedSubordinates !GlobalRdrElt (NonEmpty FastString)
-- | Incorrect @type@ keyword when importing subordinates that aren't types.
- | BadImportNonTypeSubordinates !GlobalRdrElt [GlobalRdrElt]
+ | BadImportNonTypeSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt)
-- | Incorrect @type@ keyword when importing something which isn't a type.
| BadImportAvailVar
deriving Generic
=====================================
testsuite/tests/rename/should_compile/T25983a.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983a where
+
+import Prelude hiding (Bool(X,Y))
=====================================
testsuite/tests/rename/should_compile/T25983.stderr → testsuite/tests/rename/should_compile/T25983a.stderr
=====================================
@@ -1,5 +1,5 @@
-T25983.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+T25983a.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
In the import of ‘Prelude’:
a data type called ‘Bool’ is exported, but it does not export
- any constructors or record fields called ‘X’.
+ any constructors called ‘X’, ‘Y’.
=====================================
testsuite/tests/rename/should_compile/T25983b.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983b where
+
+import Prelude hiding (Bool(fld1,fld2))
=====================================
testsuite/tests/rename/should_compile/T25983b.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983b.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a data type called ‘Bool’ is exported, but it does not export
+ any record fields called ‘fld1’, ‘fld2’.
+
=====================================
testsuite/tests/rename/should_compile/T25983c.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983c where
+
+import Prelude hiding (Bool(X,Y,fld1,fld2))
=====================================
testsuite/tests/rename/should_compile/T25983c.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983c.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a data type called ‘Bool’ is exported, but it does not export
+ any constructors or record fields called ‘X’, ‘Y’, ‘fld1’, ‘fld2’.
+
=====================================
testsuite/tests/rename/should_compile/T25983.hs → testsuite/tests/rename/should_compile/T25983d.hs
=====================================
@@ -1,5 +1,5 @@
{-# OPTIONS -Wdodgy-imports #-}
-module T25983 where
+module T25983d where
-import Prelude hiding (Bool(X))
+import Prelude hiding (Num((#)))
=====================================
testsuite/tests/rename/should_compile/T25983d.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983d.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a class called ‘Num’ is exported, but it does not export
+ any class methods or associated types called ‘#’.
+
=====================================
testsuite/tests/rename/should_compile/T25983e.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983e where
+
+import Prelude hiding (Num(f,g))
=====================================
testsuite/tests/rename/should_compile/T25983e.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983e.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a class called ‘Num’ is exported, but it does not export
+ any class methods called ‘f’, ‘g’.
+
=====================================
testsuite/tests/rename/should_compile/T25983f.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983f where
+
+import Prelude hiding (Num(F,G))
=====================================
testsuite/tests/rename/should_compile/T25983f.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983f.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a class called ‘Num’ is exported, but it does not export
+ any associated types called ‘F’, ‘G’.
+
=====================================
testsuite/tests/rename/should_compile/T25983g.hs
=====================================
@@ -0,0 +1,5 @@
+{-# OPTIONS -Wdodgy-imports #-}
+
+module T25983g where
+
+import Prelude hiding (Num(F,G,f,g))
=====================================
testsuite/tests/rename/should_compile/T25983g.stderr
=====================================
@@ -0,0 +1,5 @@
+T25983g.hs:5:24: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
+ In the import of ‘Prelude’:
+ a class called ‘Num’ is exported, but it does not export
+ any class methods or associated types called ‘F’, ‘G’, ‘f’, ‘g’.
+
=====================================
testsuite/tests/rename/should_compile/T25984a.stderr
=====================================
@@ -1,5 +1,5 @@
T25984a.hs:5:31: warning: [GHC-10237] [-Wdodgy-imports (in -Wextra)]
In the import of ‘T25984a_helper’:
a data type called ‘H’ is exported, but it does not export
- any constructors or record fields called ‘C’.
+ any constructors called ‘C’.
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -233,5 +233,11 @@ test('T25182', [extra_files(['ReExportTuples.hs'])], multimod_compile, ['T25182'
test('T22581c', [extra_files(['T22581c_helper.hs'])], multimod_compile, ['T22581c', '-v0'])
test('T22581d', combined_output, ghci_script, ['T22581d.script'])
test('T25991a', [extra_files(['T25991a_helper.hs'])], multimod_compile, ['T25991a', '-v0'])
-test('T25983', normal, compile, [''])
+test('T25983a', normal, compile, [''])
+test('T25983b', normal, compile, [''])
+test('T25983c', normal, compile, [''])
+test('T25983d', normal, compile, [''])
+test('T25983e', normal, compile, [''])
+test('T25983f', normal, compile, [''])
+test('T25983g', normal, compile, [''])
test('T25984a', [extra_files(['T25984a_helper.hs'])], multimod_compile, ['T25984a', '-v0'])
=====================================
testsuite/tests/rename/should_fail/T9006.stderr
=====================================
@@ -1,5 +1,5 @@
T9006.hs:3:16: error: [GHC-10237]
In the import of ‘T9006a’:
a data type called ‘T’ is exported, but it does not export
- any constructors or record fields called ‘T’.
+ any constructors called ‘T’.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b313d5f4d1aba23af64be3fd3f34139…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b313d5f4d1aba23af64be3fd3f34139…
You're receiving this email because of your account on gitlab.haskell.org.
1
0