[Git][ghc/ghc][wip/9.10.3-backports] 2 commits: rts: Mark API set symbols as HIDDEN and correct symbol type
by Zubin (＠wz1000) 24 Jul '25
by Zubin (＠wz1000) 24 Jul '25
24 Jul '25
Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC
Commits:
ffb03a34 by Tamar Christina at 2025-07-25T04:00:12+05:30
rts: Mark API set symbols as HIDDEN and correct symbol type
(cherry picked from commit 48e9aa3ebf5acb950a94addc6e47bfebeabead70)
- - - - -
bbc65fce by Zubin Duggal at 2025-07-25T04:00:12+05:30
Prepare 9.10.3 prerelease
- - - - -
9 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- configure.ac
- + docs/users_guide/9.10.3-notes.rst
- rts/linker/PEi386.c
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/driver/T20604/T20604.stdout
- testsuite/tests/ghci/scripts/ghci064.stdout
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -997,9 +997,9 @@ job_groups =
-- Fully static build, in theory usable on any linux distribution.
, fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine312) (splitSectionsBroken static))
-- Dynamically linked build, suitable for building your own static executables on alpine
- , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine312) (splitSectionsBroken vanilla))
+ , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) (splitSectionsBroken vanilla)))
, disableValidate (standardBuildsWithConfig AArch64 (Linux Alpine318) (splitSectionsBroken vanilla))
- , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine318) (splitSectionsBroken vanilla))
+ , alpine318BrokenTests (disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine318) (splitSectionsBroken vanilla)))
, fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) staticNativeInt)))
, validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing)
@@ -1024,6 +1024,8 @@ job_groups =
-- (see Note [Object unloading]).
fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 linker_unload_native")
+ alpine318BrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "scc001")
+
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
tsan_jobs =
=====================================
.gitlab/jobs.yaml
=====================================
@@ -830,7 +830,7 @@
".gitlab/ci.sh clean",
"cat ci_timings"
],
- "allow_failure": false,
+ "allow_failure": true,
"artifacts": {
"expire_in": "8 weeks",
"paths": [
@@ -1006,7 +1006,7 @@
"variables": {
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_18-validate",
- "BROKEN_TESTS": "encoding004 T10458",
+ "BROKEN_TESTS": "scc001 encoding004 T10458",
"BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
"INSTALL_CONFIGURE_ARGS": "--disable-ld-override",
@@ -3244,7 +3244,7 @@
".gitlab/ci.sh clean",
"cat ci_timings"
],
- "allow_failure": false,
+ "allow_failure": true,
"artifacts": {
"expire_in": "1 year",
"paths": [
@@ -3358,7 +3358,7 @@
"variables": {
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_18-release+no_split_sections",
- "BROKEN_TESTS": "encoding004 T10458",
+ "BROKEN_TESTS": "scc001 encoding004 T10458",
"BUILD_FLAVOUR": "release+no_split_sections",
"CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check",
"HADRIAN_ARGS": "--hash-unit-ids",
=====================================
configure.ac
=====================================
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.10.2], [glasgow-ha
AC_CONFIG_MACRO_DIRS([m4])
# Set this to YES for a released version, otherwise NO
-: ${RELEASE=YES}
+: ${RELEASE=NO}
# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
# above. If this is not a released version, then we will append the
=====================================
docs/users_guide/9.10.3-notes.rst
=====================================
@@ -0,0 +1,165 @@
+.. _release-9-10-3:
+
+Version 9.10.3
+===============
+The significant changes to the various parts of the compiler are listed in the
+following sections. See the `migration guide
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.10>`_ on the GHC Wiki
+for specific guidance on migrating programs to this release.
+
+
+Compiler
+~~~~~~~~
+
+- Don't cache solved [W] HasCallStack constraints to avoid re-using old
+ call-stacks instead of constructing new ones. (:ghc-ticket:`25529`)
+
+- Fix EmptyCase panic in tcMatches when \case{} is checked against a function
+ type preceded by invisible forall. (:ghc-ticket:`25960`)
+
+- Fix panic triggered by combination of \case{} and forall t ->. (:ghc-ticket:`25004`)
+
+- Fix GHC.SysTools.Ar archive member size writing logic that was emitting wrong
+ archive member sizes in headers. (:ghc-ticket:`26120`, :ghc-ticket:`22586`)
+
+- Fix multiple bugs in name resolution of subordinate import lists related to
+ type namespace specifiers and hiding clauses. (:ghc-ticket:`22581`, :ghc-ticket:`25983`, :ghc-ticket:`25984`, :ghc-ticket:`25991`)
+
+- Use mkTrAppChecked in ds_ev_typeable to avoid false negatives for type
+ equality involving function types. (:ghc-ticket:`25998`)
+
+- Fix bytecode generation for ``tagToEnum# <LITERAL>``. (:ghc-ticket:`25975`)
+
+- Don't report used duplicate record fields as unused. (:ghc-ticket:`24035`)
+
+- Propagate long distance info to guarded let binds for better pattern-match
+ checking warnings. (:ghc-ticket:`25749`)
+
+- Prevent incorrect unpacking optimizations for GADTs with multiple constructors. (:ghc-ticket:`25672`)
+
+- Introduce a separate argument limit for forced specs via SPEC argument with
+ warning when limit is exceeded. (:ghc-ticket:`25197`)
+
+Build system and packaging
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+- 9.10 hadrian can build with Cabal-3.12.1. (:ghc-ticket:`25605`)
+
+- GHC settings: always unescape escaped spaces to fix handling of spaces in
+ executable paths. (:ghc-ticket:`25204`)
+
+Native code generator backend
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+- x86 NCG: Fix code generation of bswap64 on i386. (:ghc-ticket:`25601`)
+
+- AArch64 NCG: Fix sub-word arithmetic right shift by zero-extending sub-word
+ values. (:ghc-ticket:`26061`)
+
+- NCG: AArch64 - Add -finter-module-far-jumps flag for modules with far jumps
+ outside the current module. (:ghc-ticket:`24648`)
+
+LLVM backend
+~~~~~~~~~~~~
+
+- LLVM: fix typo in padLiveArgs that was incorrectly computing too many padding
+ registers causing segfaults. (:ghc-ticket:`25770`, :ghc-ticket:`25773`)
+
+- llvmGen: Fix linkage of built-in arrays to use Appending linkage instead of
+ Internal. (:ghc-ticket:`25769`)
+
+- llvmGen: Fix built-in variable predicate to check for `@llvm` rather than
+ `$llvm`.
+
+WebAssembly backend
+~~~~~~~~~~~~~~~~~~~
+
+- wasm: use primitive opcodes for fabs and sqrt operations.
+
+Runtime system
+~~~~~~~~~~~~~~
+
+- rts: Implement WEAK EXTERNAL undef redirection by target symbol name.
+
+- rts: Handle API set symbol versioning conflicts.
+
+- rts: fix rts_clearMemory logic when sanity checks are enabled. (:ghc-ticket:`26011`)
+
+- rts/linker: Improve efficiency of proddable blocks structure by using binary
+ search instead of linked lists for better performance with split sections. (:ghc-ticket:`26009`)
+
+- rts/linker/PEi386: Don't repeatedly load DLLs by maintaining a hash-set of
+ loaded DLL names. (:ghc-ticket:`26009`, :ghc-ticket:`26052`)
+
+- rts/linker: Don't fail due to RTLD_NOW by attempting eager binding first,
+ then reverting to lazy binding on failure. (:ghc-ticket:`25943`)
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- base: Expose Backtraces constructor and fields. (:ghc-ticket:`26049`)
+
+- base: Note strictness changes made in 4.16.0.0. (:ghc-ticket:`25886`)
+
+- Fix bugs in ``integerRecipMod`` and ``integerPowMod`` return values. (:ghc-ticket:`26017`)
+
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+- perf: Replace uses of genericLength with strictGenericLength to reduce time
+ spent in 'assembleBCOs' and allocations. (:ghc-ticket:`25706`)
+
+Build tools
+~~~~~~~~~~~
+
+- configure: Drop probing of ld.gold since `gold` has been dropped from
+ binutils-2.44. (:ghc-ticket:`25716`)
+
+- get-win32-tarballs.py: List tarball files to be downloaded if we cannot find
+ them. (:ghc-ticket:`25929`)
+
+- hp2ps Utilities.c: include stdlib.h instead of extern malloc and realloc.
+
+Included libraries
+~~~~~~~~~~~~~~~~~~
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
\ No newline at end of file
=====================================
rts/linker/PEi386.c
=====================================
@@ -1181,8 +1181,10 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f
// Because the symbol has been loaded before we actually need it, if a
// stronger reference wants to add a duplicate we should discard this
// one to preserve link order.
- if (!ghciInsertSymbolTable(dll, symhash, symbol, sym, false,
- SYM_TYPE_CODE | SYM_TYPE_DUP_DISCARD, NULL))
+ SymType symType = SYM_TYPE_DUP_DISCARD | SYM_TYPE_HIDDEN;
+ symType |= hdr.Type == IMPORT_OBJECT_CODE ? SYM_TYPE_CODE : SYM_TYPE_DATA;
+
+ if (!ghciInsertSymbolTable(dll, symhash, symbol, sym, false, symType, NULL))
return false;
return true;
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1493,7 +1493,7 @@ async def do_test(name: TestName,
dst_makefile = in_testdir('Makefile')
if src_makefile.exists():
makefile = src_makefile.read_text(encoding='UTF-8')
- makefile = re.sub('TOP=.*', 'TOP=%s' % config.top, makefile, 1)
+ makefile = re.sub('TOP=.*', 'TOP=%s' % config.top, makefile, count=1)
dst_makefile.write_text(makefile, encoding='UTF-8')
if opts.pre_cmd:
@@ -2708,7 +2708,7 @@ def normalise_errmsg(s: str) -> str:
# filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10
# and not understood by older binutils (ar, ranlib, ...)
- s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
+ s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE (?: \(5\) )? type: 0xc000000(.*)$', '', l))
s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
=====================================
testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
=====================================
@@ -13,13 +13,13 @@ Building library 'q' instantiated with
for bkpcabal08-0.1.0.0...
[2 of 4] Compiling B[sig] ( q/B.hsig, nothing )
[3 of 4] Compiling M ( q/M.hs, nothing ) [A changed]
-[4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p
+[4 of 4] Instantiating bkpcabal08-0.1.0.0-Asivy2QkF0WEbGENiw5nyj-p
Preprocessing library 'q' for bkpcabal08-0.1.0.0...
Building library 'q' instantiated with
- A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A
- B = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:B
+ A = bkpcabal08-0.1.0.0-BznDTmYyvWf7fdEdPEncB4-impl:A
+ B = bkpcabal08-0.1.0.0-BznDTmYyvWf7fdEdPEncB4-impl:B
for bkpcabal08-0.1.0.0...
-[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/A.o ) [Prelude package changed]
-[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/B.o ) [Prelude package changed]
+[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-BOgmYfE3t0l9LsOUH0dl5H-q+sLNLgjkt61DMZK9wGbx81/A.o ) [Prelude package changed]
+[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-BOgmYfE3t0l9LsOUH0dl5H-q+sLNLgjkt61DMZK9wGbx81/B.o ) [Prelude package changed]
Preprocessing library 'r' for bkpcabal08-0.1.0.0...
Building library 'r' for bkpcabal08-0.1.0.0...
=====================================
testsuite/tests/driver/T20604/T20604.stdout
=====================================
@@ -1,11 +1,10 @@
A1
A
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-prim-0.10.0-inplace-ghc9.9.20230815.so" 1403aed32fb9af243c4cc949007c846c
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-bignum-1.3-inplace-ghc9.9.20230815.so" 54293f8faab737bac998f6e1a1248db8
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-internal-0.1.0.0-inplace-ghc9.9.20230815.so" a5c0e962d84d9044d44df4698becddcc
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSbase-4.19.0.0-inplace-ghc9.9.20230815.so" 4a90ed136fe0f89e5d0360daded517bd
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-boot-th-9.9-inplace-ghc9.9.20230815.so" e338655f71b1d37fdfdd2504b7de6e76
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSarray-0.5.6.0-inplace-ghc9.9.20230815.so" 6943478e8adaa043abf7a2b38dd435a2
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSdeepseq-1.5.0.0-inplace-ghc9.9.20230815.so" 9974eb196694990ac6bb3c2591405de0
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSpretty-1.1.3.6-inplace-ghc9.9.20230815.so" 1eefc21514f5584086f62b70aa554b7d
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHStemplate-haskell-2.21.0.0-inplace-ghc9.9.20230815.so" f85c86eb94dcce1eacd739b6e991ba2d
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-prim-0.12.0-inplace-ghc9.10.2.20250724.so" 0b7cbf5659e1fd221ea306e2da08c7d3
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-bignum-1.3-inplace-ghc9.10.2.20250724.so" 1c29a409bcfbc31a3cfc2ded7c1d5530
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-internal-9.1002.0-inplace-ghc9.10.2.20250724.so" 9606aee1cbbee934848aa85568563754
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSbase-4.20.1.0-inplace-ghc9.10.2.20250724.so" 5d1ab384becff6d4b20bae121d55fbc8
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-boot-th-9.10.2.20250724-inplace-ghc9.10.2.20250724.so" 930b5206ff48d75ba522e582262695a8
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSdeepseq-1.5.2.0-inplace-ghc9.10.2.20250724.so" db23e7880c9a9fee0d494b48294c3487
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSpretty-1.1.3.6-inplace-ghc9.10.2.20250724.so" ad484cfb103f02509b1be6abcf2a402f
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHStemplate-haskell-2.22.0.0-inplace-ghc9.10.2.20250724.so" 50b2cb166e6e5293c24be374ffac2ade
=====================================
testsuite/tests/ghci/scripts/ghci064.stdout
=====================================
@@ -27,12 +27,12 @@ instance [safe] Eq w => Eq (Maybe w)
-- Defined in ‘GHC.Internal.Maybe’
instance GHC.Internal.Generics.Generic [w]
-- Defined in ‘GHC.Internal.Generics’
-instance Monoid [w] -- Defined in ‘GHC.Internal.Base’
-instance Semigroup [w] -- Defined in ‘GHC.Internal.Base’
instance Read w => Read [w] -- Defined in ‘GHC.Internal.Read’
instance Eq w => Eq [w] -- Defined in ‘GHC.Classes’
instance Ord w => Ord [w] -- Defined in ‘GHC.Classes’
instance Show w => Show [w] -- Defined in ‘GHC.Internal.Show’
+instance Monoid [w] -- Defined in ‘GHC.Internal.Base’
+instance Semigroup [w] -- Defined in ‘GHC.Internal.Base’
instance [safe] MyShow w => MyShow [w]
-- Defined at ghci064.hs:8:10
instance GHC.Internal.Generics.Generic [T]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c48d725274a62c49c8e96f36e78e8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c48d725274a62c49c8e96f36e78e8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Jul '25
Bodigrim pushed new branch wip/since-for-nonempty-mapMaybe at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/since-for-nonempty-mapMaybe
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/driver-diagnostics] 3 commits: Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
by Simon Hengel (＠sol) 24 Jul '25
by Simon Hengel (＠sol) 24 Jul '25
24 Jul '25
Simon Hengel pushed to branch wip/sol/driver-diagnostics at Glasgow Haskell Compiler / GHC
Commits:
99e86cdb by Simon Hengel at 2025-07-25T03:40:43+07:00
Respect `-fdiagnostics-as-json` for core diagnostics (see #24113)
- - - - -
459bce88 by Simon Hengel at 2025-07-25T03:40:43+07:00
Don't use MCDiagnostic for `ghcExit`
This changes the error message of `ghcExit` from
```
<no location info>: error:
Compilation had errors
```
to
```
Compilation had errors
```
- - - - -
9d8559ce by Simon Hengel at 2025-07-25T03:40:43+07:00
Respect `-fdiagnostics-as-json` for driver diagnostics (see #24113)
- - - - -
8 changed files:
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Utils/Error.hs
- testsuite/tests/corelint/T21115b.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/Monad.hs
=====================================
@@ -33,7 +33,7 @@ module GHC.Core.Opt.Monad (
getAnnotations, getFirstAnnotations,
-- ** Screen output
- putMsg, putMsgS, errorMsg, msg,
+ putMsg, putMsgS, errorMsg, msg, diagnostic,
fatalErrorMsg, fatalErrorMsgS,
debugTraceMsg, debugTraceMsgS,
) where
@@ -41,6 +41,8 @@ module GHC.Core.Opt.Monad (
import GHC.Prelude hiding ( read )
import GHC.Driver.DynFlags
+import GHC.Driver.Errors ( reportDiagnostic, reportError )
+import GHC.Driver.Config.Diagnostic ( initDiagOpts )
import GHC.Driver.Env
import GHC.Core.Rules ( RuleBase, RuleEnv, mkRuleEnv )
@@ -52,7 +54,6 @@ import GHC.Types.Name.Env
import GHC.Types.SrcLoc
import GHC.Types.Error
-import GHC.Utils.Error ( errorDiagnostic )
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Logger
import GHC.Utils.Monad
@@ -383,9 +384,22 @@ putMsgS = putMsg . text
putMsg :: SDoc -> CoreM ()
putMsg = msg MCInfo
+diagnostic :: DiagnosticReason -> SDoc -> CoreM ()
+diagnostic reason doc = do
+ logger <- getLogger
+ loc <- getSrcSpanM
+ name_ppr_ctx <- getNamePprCtx
+ diag_opts <- initDiagOpts <$> getDynFlags
+ liftIO $ reportDiagnostic logger name_ppr_ctx diag_opts loc reason doc
+
-- | Output an error to the screen. Does not cause the compiler to die.
errorMsg :: SDoc -> CoreM ()
-errorMsg doc = msg errorDiagnostic doc
+errorMsg doc = do
+ logger <- getLogger
+ loc <- getSrcSpanM
+ name_ppr_ctx <- getNamePprCtx
+ diag_opts <- initDiagOpts <$> getDynFlags
+ liftIO $ reportError logger name_ppr_ctx diag_opts loc doc
-- | Output a fatal error to the screen. Does not cause the compiler to die.
fatalErrorMsgS :: String -> CoreM ()
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -45,7 +45,7 @@ import GHC.Core.Make ( mkImpossibleExpr )
import GHC.Unit.Module
import GHC.Unit.Module.ModGuts
-import GHC.Types.Error (MessageClass(..), Severity(..), DiagnosticReason(WarningWithoutFlag), ResolvedDiagnosticReason (..))
+import GHC.Types.Error (DiagnosticReason(..))
import GHC.Types.Literal ( litIsLifted )
import GHC.Types.Id
import GHC.Types.Id.Info ( IdDetails(..) )
@@ -783,12 +783,11 @@ specConstrProgram guts
; let (_usg, binds', warnings) = initUs_ us $
scTopBinds env0 (mg_binds guts)
- ; when (not (null warnings)) $ msg specConstr_warn_class (warn_msg warnings)
+ ; when (not (null warnings)) $ diagnostic WarningWithoutFlag (warn_msg warnings)
; return (guts { mg_binds = binds' }) }
where
- specConstr_warn_class = MCDiagnostic SevWarning (ResolvedDiagnosticReason WarningWithoutFlag) Nothing
warn_msg :: SpecFailWarnings -> SDoc
warn_msg warnings = text "SpecConstr encountered one or more function(s) with a SPEC argument that resulted in too many arguments," $$
text "which resulted in no specialization being generated for these functions:" $$
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -12,7 +12,6 @@ import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Config
-import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst )
@@ -55,7 +54,6 @@ import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Error
-import GHC.Utils.Error ( mkMCDiagnostic )
import GHC.Utils.Monad ( foldlM )
import GHC.Utils.Misc
import GHC.Utils.Outputable
@@ -938,10 +936,12 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn
| wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs
| otherwise = return ()
where
+ allCallersInlined :: Bool
allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers
- diag_opts = initDiagOpts dflags
+
+ doWarn :: DiagnosticReason -> CoreM ()
doWarn reason =
- msg (mkMCDiagnostic diag_opts reason Nothing)
+ diagnostic reason
(vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn))
2 (vcat [ text "when specialising" <+> quotes (ppr caller)
| caller <- callers])
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1552,7 +1552,7 @@ wrapAction msg_wrapper hsc_env k = do
-- ThreadKilled in particular needs to actually kill the thread.
-- So rethrow that and the other async exceptions
Just (err :: SomeAsyncException) -> throwIO err
- _ -> errorMsg lcl_logger (text (show exc))
+ _ -> reportError lcl_logger neverQualify emptyDiagOpts noSrcSpan (text (show exc))
return Nothing
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Settings
import GHC.Platform
import GHC.Platform.Ways
+import GHC.Driver.Errors
import GHC.Driver.Phases
import GHC.Driver.Env
import GHC.Driver.Session
@@ -50,7 +51,7 @@ import GHC.Driver.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Finder
-import GHC.Tc.Utils.Monad
+import GHC.Tc.Utils.Monad hiding (reportDiagnostic)
import GHC.Runtime.Interpreter
import GHCi.BreakArray
@@ -1307,9 +1308,9 @@ load_dyn interp hsc_env crash_early dll = do
then cmdLineErrorIO err
else do
when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts)
- $ logMsg logger
- (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing)
- noSrcSpan $ withPprStyle defaultUserStyle (note err)
+ $ reportDiagnostic logger
+ neverQualify diag_opts
+ noSrcSpan (WarningWithFlag Opt_WarnMissedExtraSharedLib) $ withPprStyle defaultUserStyle (note err)
pure Nothing
where
diag_opts = initDiagOpts (hsc_dflags hsc_env)
@@ -1497,8 +1498,7 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0
, not loading_dynamic_hs_libs
, interpreterProfiled interp
= do
- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing
- logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $
+ reportDiagnostic logger neverQualify diag_opts noSrcSpan WarningWithoutFlag $ withPprStyle defaultErrStyle $
text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
text "libraries with profiling support."
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
-import GHC.Types.SrcLoc (noLoc)
+import GHC.Types.SrcLoc (noLoc, noSrcSpan)
{-
************************************************************************
@@ -346,7 +346,7 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do
debugTraceMsg logger 2
(text "Error (figuring out LLVM version):" <+>
text (show err))
- errorMsg logger $ vcat
+ reportError logger neverQualify emptyDiagOpts noSrcSpan $ vcat
[ text "Warning:", nest 9 $
text "Couldn't figure out LLVM version!" $$
text ("Make sure you have installed LLVM between ["
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -32,7 +32,7 @@ module GHC.Utils.Error (
emptyMessages, mkDecorated, mkLocMessage,
mkMsgEnvelope, mkPlainMsgEnvelope, mkPlainErrorMsgEnvelope,
mkErrorMsgEnvelope,
- mkMCDiagnostic, errorDiagnostic, diagReasonSeverity,
+ mkMCDiagnostic, diagReasonSeverity,
mkPlainError,
mkPlainDiagnostic,
@@ -46,7 +46,6 @@ module GHC.Utils.Error (
-- * Issuing messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
- errorMsg,
fatalErrorMsg,
compilationProgressMsg,
showPass,
@@ -168,11 +167,6 @@ mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
where
(sev, reason') = diag_reason_severity opts reason
--- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
--- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
-errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
-
--
-- Creating MsgEnvelope(s)
--
@@ -318,17 +312,12 @@ sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList
ghcExit :: Logger -> Int -> IO ()
ghcExit logger val
| val == 0 = exitWith ExitSuccess
- | otherwise = do errorMsg logger (text "\nCompilation had errors\n\n")
+ | otherwise = do fatalErrorMsg logger (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
-- -----------------------------------------------------------------------------
-- Outputting messages from the compiler
-errorMsg :: Logger -> SDoc -> IO ()
-errorMsg logger msg
- = logMsg logger errorDiagnostic noSrcSpan $
- withPprStyle defaultErrStyle msg
-
fatalErrorMsg :: Logger -> SDoc -> IO ()
fatalErrorMsg logger msg =
logMsg logger MCFatal noSrcSpan $ withPprStyle defaultErrStyle msg
=====================================
testsuite/tests/corelint/T21115b.stderr
=====================================
@@ -30,6 +30,6 @@ end Rec }
*** End of Offense ***
-
-<no location info>: error:
Compilation had errors
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d3ddb0086ab4bad48450011e008d7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d3ddb0086ab4bad48450011e008d7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] STM: don't create a transaction in the rhs of catchRetry# (#26028)
by Marge Bot (＠marge-bot) 24 Jul '25
by Marge Bot (＠marge-bot) 24 Jul '25
24 Jul '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
0a583689 by Sylvain Henry at 2025-07-24T16:20:26-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
- - - - -
6 changed files:
- rts/PrimOps.cmm
- rts/RaiseAsync.c
- rts/STM.c
- + testsuite/tests/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/all.T
Changes:
=====================================
rts/PrimOps.cmm
=====================================
@@ -1211,16 +1211,27 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME,
gcptr trec, outer, arg;
trec = StgTSO_trec(CurrentTSO);
- outer = StgTRecHeader_enclosing_trec(trec);
- (r) = ccall stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr");
- if (r != 0) {
- // Succeeded (either first branch or second branch)
- StgTSO_trec(CurrentTSO) = outer;
- return (ret);
- } else {
- // Did not commit: abort and restart.
- StgTSO_trec(CurrentTSO) = outer;
- jump stg_abort();
+ if (running_alt_code != 1) {
+ // When exiting the lhs code of catchRetry# lhs rhs, we need to cleanup
+ // the nested transaction.
+ // See Note [catchRetry# implementation]
+ outer = StgTRecHeader_enclosing_trec(trec);
+ (r) = ccall stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr");
+ if (r != 0) {
+ // Succeeded in first branch
+ StgTSO_trec(CurrentTSO) = outer;
+ return (ret);
+ } else {
+ // Did not commit: abort and restart.
+ StgTSO_trec(CurrentTSO) = outer;
+ jump stg_abort();
+ }
+ }
+ else {
+ // nothing to do in the rhs code of catchRetry# lhs rhs, it's already
+ // using the parent transaction (not a nested one).
+ // See Note [catchRetry# implementation]
+ return (ret);
}
}
@@ -1453,21 +1464,26 @@ retry_pop_stack:
outer = StgTRecHeader_enclosing_trec(trec);
if (frame_type == CATCH_RETRY_FRAME) {
- // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
- ASSERT(outer != NO_TREC);
- // Abort the transaction attempting the current branch
- ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
- ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
+ // The retry reaches a CATCH_RETRY_FRAME before the ATOMICALLY_FRAME
+
if (!StgCatchRetryFrame_running_alt_code(frame) != 0) {
- // Retry in the first branch: try the alternative
- ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr");
- StgTSO_trec(CurrentTSO) = trec;
+ // Retrying in the lhs of catchRetry# lhs rhs, i.e. in a nested
+ // transaction. See Note [catchRetry# implementation]
+
+ // check that we have a parent transaction
+ ASSERT(outer != NO_TREC);
+
+ // Abort the nested transaction
+ ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
+ ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
+
+ // As we are retrying in the lhs code, we must now try the rhs code
+ StgTSO_trec(CurrentTSO) = outer;
StgCatchRetryFrame_running_alt_code(frame) = 1 :: CInt; // true;
R1 = StgCatchRetryFrame_alt_code(frame);
jump stg_ap_v_fast [R1];
} else {
- // Retry in the alternative code: propagate the retry
- StgTSO_trec(CurrentTSO) = outer;
+ // Retry in the rhs code: propagate the retry
Sp = Sp + SIZEOF_StgCatchRetryFrame;
goto retry_pop_stack;
}
=====================================
rts/RaiseAsync.c
=====================================
@@ -1043,8 +1043,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
}
case CATCH_STM_FRAME:
- case CATCH_RETRY_FRAME:
- // CATCH frames within an atomically block: abort the
+ // CATCH_STM frame within an atomically block: abort the
// inner transaction and continue. Eventually we will
// hit the outer transaction that will get frozen (see
// above).
@@ -1056,14 +1055,40 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
{
StgTRecHeader *trec = tso -> trec;
StgTRecHeader *outer = trec -> enclosing_trec;
- debugTraceCap(DEBUG_stm, cap,
- "found atomically block delivering async exception");
+ debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_STM frame");
stmAbortTransaction(cap, trec);
stmFreeAbortedTRec(cap, trec);
tso -> trec = outer;
break;
};
+ case CATCH_RETRY_FRAME:
+ // CATCH_RETY frame within an atomically block: if we're executing
+ // the lhs code, abort the inner transaction and continue; if we're
+ // executing thr rhs, continue (no nested transaction to abort. See
+ // Note [catchRetry# implementation]). Eventually we will hit the
+ // outer transaction that will get frozen (see above).
+ //
+ // As for the CATCH_STM_FRAME case above, we do not care
+ // whether the transaction is valid or not because its
+ // possible validity cannot have caused the exception
+ // and will not be visible after the abort.
+ {
+ if (!((StgCatchRetryFrame *)frame) -> running_alt_code) {
+ debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_RETRY frame (lhs)");
+ StgTRecHeader *trec = tso -> trec;
+ StgTRecHeader *outer = trec -> enclosing_trec;
+ stmAbortTransaction(cap, trec);
+ stmFreeAbortedTRec(cap, trec);
+ tso -> trec = outer;
+ }
+ else
+ {
+ debugTraceCap(DEBUG_stm, cap, "raiseAsync: traversing CATCH_RETRY frame (rhs)");
+ }
+ break;
+ };
+
default:
// see Note [Update async masking state on unwind] in Schedule.c
if (*frame == (W_)&stg_unmaskAsyncExceptionszh_ret_info) {
=====================================
rts/STM.c
=====================================
@@ -1505,3 +1505,30 @@ void stmWriteTVar(Capability *cap,
}
/*......................................................................*/
+
+
+
+/*
+
+Note [catchRetry# implementation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+catchRetry# creates a nested transaction for its lhs:
+- if the lhs transaction succeeds:
+ - the lhs transaction is committed
+ - its read-variables are merged with those of the parent transaction
+ - the rhs code is ignored
+- if the lhs transaction retries:
+ - the lhs transaction is aborted
+ - its read-variables are merged with those of the parent transaction
+ - the rhs code is executed directly in the parent transaction (see #26028).
+
+So note that:
+- lhs code uses a nested transaction
+- rhs code doesn't use a nested transaction
+
+We have to take which case we're in into account (using the running_alt_code
+field of the catchRetry frame) in catchRetry's entry code, in retry#
+implementation, and also when an async exception is received (to cleanup the
+right number of transactions).
+
+*/
=====================================
testsuite/tests/lib/stm/T26028.hs
=====================================
@@ -0,0 +1,23 @@
+module Main where
+
+import GHC.Conc
+
+forever :: IO String
+forever = delay 10 >> forever
+
+terminates :: IO String
+terminates = delay 1 >> pure "terminates"
+
+delay s = threadDelay (1000000 * s)
+
+async :: IO a -> IO (STM a)
+async a = do
+ var <- atomically (newTVar Nothing)
+ forkIO (a >>= atomically . writeTVar var . Just)
+ pure (readTVar var >>= maybe retry pure)
+
+main :: IO ()
+main = do
+ x <- mapM async $ terminates : replicate 50000 forever
+ r <- atomically (foldr1 orElse x)
+ print r
=====================================
testsuite/tests/lib/stm/T26028.stdout
=====================================
@@ -0,0 +1 @@
+"terminates"
=====================================
testsuite/tests/lib/stm/all.T
=====================================
@@ -0,0 +1 @@
+test('T26028', only_ways(['threaded1']), compile_and_run, ['-O2'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a5836891ca29836a24c306d2a364c2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a5836891ca29836a24c306d2a364c2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] CprAnal: Detect recursive newtypes (#25944)
by Marge Bot (＠marge-bot) 24 Jul '25
by Marge Bot (＠marge-bot) 24 Jul '25
24 Jul '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4bc78496 by Sebastian Graf at 2025-07-24T16:19:34-04:00
CprAnal: Detect recursive newtypes (#25944)
While `cprTransformDataConWork` handles recursive data con workers, it
did not detect the case when a newtype is responsible for the recursion.
This is now detected in the `Cast` case of `cprAnal`.
The same reproducer made it clear that `isRecDataCon` lacked congruent
handling for `AppTy` and `CastTy`, now fixed.
Furthermore, the new repro case T25944 triggered this bug via an
infinite loop in `cprFix`, caused by the infelicity in `isRecDataCon`.
While it should be much less likely to trigger such an infinite loop now
that `isRecDataCon` has been fixed, I made sure to abort the loop after
10 iterations and emitting a warning instead.
Fixes #25944.
- - - - -
5 changed files:
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- + testsuite/tests/cpranal/sigs/T25944.hs
- + testsuite/tests/cpranal/sigs/T25944.stderr
- testsuite/tests/cpranal/sigs/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/CprAnal.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
-- | Constructed Product Result analysis. Identifies functions that surely
-- return heap-allocated records on every code path, so that we can eliminate
@@ -22,12 +23,15 @@ import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Types.Unique.MemoFun
+import GHC.Core
import GHC.Core.FamInstEnv
import GHC.Core.DataCon
import GHC.Core.Type
import GHC.Core.Utils
-import GHC.Core
+import GHC.Core.Coercion
+import GHC.Core.Reduction
import GHC.Core.Seq
+import GHC.Core.TyCon
import GHC.Core.Opt.WorkWrap.Utils
import GHC.Data.Graph.UnVar -- for UnVarSet
@@ -216,9 +220,13 @@ cprAnal' _ (Type ty) = (topCprType, Type ty) -- Doesn't happen, in fact
cprAnal' _ (Coercion co) = (topCprType, Coercion co)
cprAnal' env (Cast e co)
- = (cpr_ty, Cast e' co)
+ = (cpr_ty', Cast e' co)
where
(cpr_ty, e') = cprAnal env e
+ cpr_ty'
+ | cpr_ty == topCprType = topCprType -- cheap case first
+ | isRecNewTyConApp env (coercionRKind co) = topCprType -- See Note [CPR for recursive data constructors]
+ | otherwise = cpr_ty
cprAnal' env (Tick t e)
= (cpr_ty, Tick t e')
@@ -391,6 +399,19 @@ cprTransformDataConWork env con args
mAX_CPR_SIZE :: Arity
mAX_CPR_SIZE = 10
+isRecNewTyConApp :: AnalEnv -> Type -> Bool
+-- See Note [CPR for recursive newtype constructors]
+isRecNewTyConApp env ty
+ --- | pprTrace "isRecNewTyConApp" (ppr ty) False = undefined
+ | Just (tc, tc_args) <- splitTyConApp_maybe ty =
+ if | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe (ae_fam_envs env) tc tc_args
+ -> isRecNewTyConApp env rhs
+ | Just dc <- newTyConDataCon_maybe tc
+ -> ae_rec_dc env dc == DefinitelyRecursive
+ | otherwise
+ -> False
+ | otherwise = False
+
--
-- * Bindings
--
@@ -414,12 +435,18 @@ cprFix orig_env orig_pairs
| otherwise = orig_pairs
init_env = extendSigEnvFromIds orig_env (map fst init_pairs)
+ -- If fixed-point iteration does not yield a result we use this instead
+ -- See Note [Safe abortion in the fixed-point iteration]
+ abort :: (AnalEnv, [(Id,CoreExpr)])
+ abort = step (nonVirgin orig_env) [(setIdCprSig id topCprSig, rhs) | (id, rhs) <- orig_pairs ]
+
-- The fixed-point varies the idCprSig field of the binders and and their
-- entries in the AnalEnv, and terminates if that annotation does not change
-- any more.
loop :: Int -> AnalEnv -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)])
loop n env pairs
| found_fixpoint = (reset_env', pairs')
+ | n == 10 = pprTraceUserWarning (text "cprFix aborts. This is not terrible, but worth reporting a GHC issue." <+> ppr (map fst pairs)) $ abort
| otherwise = loop (n+1) env' pairs'
where
-- In all but the first iteration, delete the virgin flag
@@ -519,8 +546,9 @@ cprAnalBind env id rhs
-- possibly trim thunk CPR info
rhs_ty'
-- See Note [CPR for thunks]
- | stays_thunk = trimCprTy rhs_ty
- | otherwise = rhs_ty
+ | rhs_ty == topCprType = topCprType -- cheap case first
+ | stays_thunk = trimCprTy rhs_ty
+ | otherwise = rhs_ty
-- See Note [Arity trimming for CPR signatures]
sig = mkCprSigForArity (idArity id) rhs_ty'
-- See Note [OPAQUE pragma]
@@ -639,7 +667,7 @@ data AnalEnv
, ae_fam_envs :: FamInstEnvs
-- ^ Needed when expanding type families and synonyms of product types.
, ae_rec_dc :: DataCon -> IsRecDataConResult
- -- ^ Memoised result of 'GHC.Core.Opt.WorkWrap.Utils.isRecDataCon'
+ -- ^ Memoised result of 'GHC.Core.Opt.WorkWrap.Utils.isRecDataType
}
instance Outputable AnalEnv where
@@ -1042,10 +1070,11 @@ Eliminating the shared 'c' binding in the process. And then
What can we do about it?
- A. Don't CPR functions that return a *recursive data type* (the list in this
- case). This is the solution we adopt. Rationale: the benefit of CPR on
- recursive data structures is slight, because it only affects the outer layer
- of a potentially massive data structure.
+ A. Don't give recursive data constructors or casts representing recursive newtype constructors
+ the CPR property (the list in this case). This is the solution we adopt.
+ Rationale: the benefit of CPR on recursive data structures is slight,
+ because it only affects the outer layer of a potentially massive data
+ structure.
B. Don't CPR any *recursive function*. That would be quite conservative, as it
would also affect e.g. the factorial function.
C. Flat CPR only for recursive functions. This prevents the asymptotic
@@ -1055,10 +1084,15 @@ What can we do about it?
`c` in the second eqn of `replicateC`). But we'd need to know which paths
were hot. We want such static branch frequency estimates in #20378.
-We adopt solution (A) It is ad-hoc, but appears to work reasonably well.
-Deciding what a "recursive data constructor" is is quite tricky and ad-hoc, too:
-See Note [Detecting recursive data constructors]. We don't have to be perfect
-and can simply keep on unboxing if unsure.
+We adopt solution (A). It is ad-hoc, but appears to work reasonably well.
+Specifically:
+
+* For data constructors, in `cprTransformDataConWork` we check for a recursive
+ data constructor by calling `ae_rec_dc env`, which is just a memoised version
+ of `isRecDataCon`. See Note [Detecting recursive data constructors]
+* For newtypes, in the `Cast` case of `cprAnal`, we check for a recursive newtype
+ by calling `isRecNewTyConApp`, which in turn calls `ae_rec_dc env`.
+ See Note [CPR for recursive newtype constructors]
Note [Detecting recursive data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1075,12 +1109,15 @@ looks inside the following class of types, represented by `ty` (and responds
types of its data constructors and check `tc_args` for recursion.
C. If `ty = F tc_args`, `F` is a `FamTyCon` and we can reduce `F tc_args` to
`rhs`, look into the `rhs` type.
+ D. If `ty = f a`, then look into `f` and `a`
+ E. If `ty = ty' |> co`, then look into `ty'`
A few perhaps surprising points:
1. It deems any function type as non-recursive, because it's unlikely that
a recursion through a function type builds up a recursive data structure.
- 2. It doesn't look into kinds or coercion types because there's nothing to unbox.
+ 2. It doesn't look into kinds, literals or coercion types because we are
+ ultimately looking for value-level recursion.
Same for promoted data constructors.
3. We don't care whether an AlgTyCon app `T tc_args` is fully saturated or not;
we simply look at its definition/DataCons and its field tys and look for
@@ -1153,6 +1190,22 @@ I've played with the idea to make points (1) through (3) of 'isRecDataCon'
configurable like (4) to enable more re-use throughout the compiler, but haven't
found a killer app for that yet, so ultimately didn't do that.
+Note [CPR for recursive newtype constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A newtype constructor is considered recursive iff the data constructor of the
+equivalent datatype definition is recursive.
+See Note [CPR for recursive data constructors].
+Detection is a bit complicated by the fact that newtype constructor applications
+reflect as Casts in Core:
+
+ newtype List a = C (Maybe (a, List a))
+ xs = C (Just (0, C Nothing))
+ ==> {desugar to Core}
+ xs = Just (0, Nothing |> sym N:List) |> sym N:List
+
+So the check for `isRecNewTyConApp` is in the Cast case of `cprAnal` rather than
+in `cprTransformDataConWork` as for data constructors.
+
Note [CPR examples]
~~~~~~~~~~~~~~~~~~~
Here are some examples (stranal/should_compile/T10482a) of the
=====================================
compiler/GHC/Core/Opt/WorkWrap/Utils.hs
=====================================
@@ -63,6 +63,7 @@ import Data.List ( unzip4 )
import GHC.Types.RepType
import GHC.Unit.Types
+import GHC.Core.TyCo.Rep
{-
************************************************************************
@@ -1426,23 +1427,29 @@ isRecDataCon fam_envs fuel orig_dc
| arg_ty <- map scaledThing (dataConRepArgTys dc) ]
go_arg_ty :: IntWithInf -> TyConSet -> Type -> IsRecDataConResult
- go_arg_ty fuel visited_tcs ty
- --- | pprTrace "arg_ty" (ppr ty) False = undefined
+ go_arg_ty fuel visited_tcs ty = -- pprTrace "arg_ty" (ppr ty) $
+ case coreFullView ty of
+ TyConApp tc tc_args -> go_tc_app fuel visited_tcs tc tc_args
+ -- See Note [Detecting recursive data constructors], points (B) and (C)
- | Just (_tcv, ty') <- splitForAllTyCoVar_maybe ty
- = go_arg_ty fuel visited_tcs ty'
+ ForAllTy _ ty' -> go_arg_ty fuel visited_tcs ty'
-- See Note [Detecting recursive data constructors], point (A)
- | Just (tc, tc_args) <- splitTyConApp_maybe ty
- = go_tc_app fuel visited_tcs tc tc_args
+ CastTy ty' _ -> go_arg_ty fuel visited_tcs ty'
- | otherwise
- = NonRecursiveOrUnsure
+ AppTy f a -> go_arg_ty fuel visited_tcs f `combineIRDCR` go_arg_ty fuel visited_tcs a
+ -- See Note [Detecting recursive data constructors], point (D)
+
+ FunTy{} -> NonRecursiveOrUnsure
+ -- See Note [Detecting recursive data constructors], point (1)
+
+ -- (TyVarTy{} | LitTy{} | CastTy{})
+ _ -> NonRecursiveOrUnsure
go_tc_app :: IntWithInf -> TyConSet -> TyCon -> [Type] -> IsRecDataConResult
go_tc_app fuel visited_tcs tc tc_args =
case tyConDataCons_maybe tc of
- --- | pprTrace "tc_app" (vcat [ppr tc, ppr tc_args]) False = undefined
+ ---_ | pprTrace "tc_app" (vcat [ppr tc, ppr tc_args]) False -> undefined
_ | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args
-- This is the only place where we look at tc_args, which might have
-- See Note [Detecting recursive data constructors], point (C) and (5)
=====================================
testsuite/tests/cpranal/sigs/T25944.hs
=====================================
@@ -0,0 +1,114 @@
+{-# LANGUAGE UndecidableInstances, LambdaCase #-}
+
+-- | This file starts with a small reproducer for #25944 that is easy to debug
+-- and then continues with a much larger MWE that is faithful to the original
+-- issue.
+module T25944 (foo, bar, popMinOneT, popMinOne) where
+
+import Data.Functor.Identity ( Identity(..) )
+import Data.Coerce
+
+data ListCons a b = Nil | a :- !b
+newtype Fix f = Fix (f (Fix f)) -- Rec
+
+foo :: Fix (ListCons a) -> Fix (ListCons a) -> Fix (ListCons a)
+foo a b = go a
+ where
+ -- The outer loop arranges it so that the base case `go as` of `go2` is
+ -- bottom on the first iteration of the loop.
+ go (Fix Nil) = Fix Nil
+ go (Fix (a :- as)) = Fix (a :- go2 b)
+ where
+ go2 (Fix Nil) = go as
+ go2 (Fix (b :- bs)) = Fix (b :- go2 bs)
+
+bar :: Int -> (Fix (ListCons Int), Int)
+bar n = (foo (Fix Nil) (Fix Nil), n) -- should still have CPR property
+
+-- Now the actual reproducer from #25944:
+
+newtype ListT m a = ListT { runListT :: m (ListCons a (ListT m a)) }
+
+cons :: Applicative m => a -> ListT m a -> ListT m a
+cons x xs = ListT (pure (x :- xs))
+
+nil :: Applicative m => ListT m a
+nil = ListT (pure Nil)
+
+instance Functor m => Functor (ListT m) where
+ fmap f (ListT m) = ListT (go <$> m)
+ where
+ go Nil = Nil
+ go (a :- m) = f a :- (f <$> m)
+
+foldListT :: ((ListCons a (ListT m a) -> c) -> m (ListCons a (ListT m a)) -> b)
+ -> (a -> b -> c)
+ -> c
+ -> ListT m a -> b
+foldListT r c n = r h . runListT
+ where
+ h Nil = n
+ h (x :- ListT xs) = c x (r h xs)
+{-# INLINE foldListT #-}
+
+mapListT :: forall a m b. Monad m => (a -> ListT m b -> ListT m b) -> ListT m b -> ListT m a -> ListT m b
+mapListT =
+ foldListT
+ ((coerce ::
+ ((ListCons a (ListT m a) -> m (ListCons b (ListT m b))) -> m (ListCons a (ListT m a)) -> m (ListCons b (ListT m b))) ->
+ ((ListCons a (ListT m a) -> ListT m b) -> m (ListCons a (ListT m a)) -> ListT m b))
+ (=<<))
+{-# INLINE mapListT #-}
+
+instance Monad m => Applicative (ListT m) where
+ pure x = cons x nil
+ {-# INLINE pure #-}
+ liftA2 f xs ys = mapListT (\x zs -> mapListT (cons . f x) zs ys) nil xs
+ {-# INLINE liftA2 #-}
+
+instance Monad m => Monad (ListT m) where
+ xs >>= f = mapListT (flip (mapListT cons) . f) nil xs
+ {-# INLINE (>>=) #-}
+
+infixr 5 :<
+data Node w a b = Leaf a | !w :< b
+ deriving (Functor)
+
+bimapNode f g (Leaf x) = Leaf (f x)
+bimapNode f g (x :< xs) = x :< g xs
+
+newtype HeapT w m a = HeapT { runHeapT :: ListT m (Node w a (HeapT w m a)) }
+
+-- | The 'Heap' type, specialised to the 'Identity' monad.
+type Heap w = HeapT w Identity
+
+instance Functor m => Functor (HeapT w m) where
+ fmap f = HeapT . fmap (bimapNode f (fmap f)) . runHeapT
+
+instance Monad m => Applicative (HeapT w m) where
+ pure = HeapT . pure . Leaf
+ (<*>) = liftA2 id
+
+instance Monad m => Monad (HeapT w m) where
+ HeapT m >>= f = HeapT (m >>= g)
+ where
+ g (Leaf x) = runHeapT (f x)
+ g (w :< xs) = pure (w :< (xs >>= f))
+
+popMinOneT :: forall w m a. (Monoid w, Monad m) => HeapT w m a -> m (Maybe ((a, w), HeapT w m a))
+popMinOneT = go mempty [] . runHeapT
+ where
+ go' :: w -> Maybe (w, HeapT w m a) -> m (Maybe ((a, w), HeapT w m a))
+ go' a Nothing = pure Nothing
+ go' a (Just (w, HeapT xs)) = go (a <> w) [] xs
+
+ go :: w -> [(w, HeapT w m a)] -> ListT m (Node w a (HeapT w m a)) -> m (Maybe ((a, w), HeapT w m a))
+ go w a (ListT xs) = xs >>= \case
+ Nil -> go' w (undefined)
+ Leaf x :- xs -> pure (Just ((x, w), undefined >> HeapT (foldl (\ys (yw,y) -> ListT (pure ((yw :< y) :- ys))) xs a)))
+ (u :< x) :- xs -> go w ((u,x) : a) xs
+{-# INLINE popMinOneT #-}
+
+popMinOne :: Monoid w => Heap w a -> Maybe ((a, w), Heap w a)
+popMinOne = runIdentity . popMinOneT
+{-# INLINE popMinOne #-}
=====================================
testsuite/tests/cpranal/sigs/T25944.stderr
=====================================
@@ -0,0 +1,17 @@
+
+==================== Cpr signatures ====================
+T25944.$fApplicativeHeapT:
+T25944.$fApplicativeListT:
+T25944.$fFunctorHeapT:
+T25944.$fFunctorListT:
+T25944.$fFunctorNode:
+T25944.$fMonadHeapT:
+T25944.$fMonadListT:
+T25944.bar: 1
+T25944.foo:
+T25944.popMinOne: 2(1(1,))
+T25944.popMinOneT:
+T25944.runHeapT:
+T25944.runListT:
+
+
=====================================
testsuite/tests/cpranal/sigs/all.T
=====================================
@@ -12,3 +12,4 @@ test('T16040', normal, compile, [''])
test('T19232', normal, compile, [''])
test('T19398', normal, compile, [''])
test('T19822', normal, compile, [''])
+test('T25944', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc78496406f7469640faaa46e2f311…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc78496406f7469640faaa46e2f311…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/amg/castz] Attempt to improve T5030 by zapping in ds_hs_wrapper
by Adam Gundry (＠adamgundry) 24 Jul '25
by Adam Gundry (＠adamgundry) 24 Jul '25
24 Jul '25
Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC
Commits:
bd2aa21d by Adam Gundry at 2025-07-24T20:08:56+01:00
Attempt to improve T5030 by zapping in ds_hs_wrapper
- - - - -
1 changed file:
- compiler/GHC/HsToCore/Binds.hs
Changes:
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -58,6 +58,7 @@ import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.Rules
import GHC.Core.TyCo.Compare( eqType )
+import GHC.Core.TyCo.FVs
import GHC.Builtin.Names
import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy )
@@ -1666,7 +1667,12 @@ ds_hs_wrapper wrap = go wrap
go (WpEvLam ev) k = k $ Lam ev
go (WpTyLam tv) k = k $ Lam tv
go (WpCast co) k = assert (coercionRole co == Representational) $
- k $ \e -> mkCastDs e co
+ do { zap_casts <- hasZapCasts <$> getDynFlags
+ ; k $ \e -> -- AMG TODO: clean this up if it helps T5030
+ if zap_casts
+ then (if isReflCo co then e else mkCastZ e (coercionRKind co) (shallowCoVarsOfCo co))
+ else mkCastDs e co
+ }
go (WpEvApp tm) k = do { core_tm <- dsEvTerm tm
; k $ \e -> e `App` core_tm }
go (WpLet ev_binds) k = dsTcEvBinds ev_binds $ \bs ->
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd2aa21d6c8a6d9eb1a0576dbf354fe…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd2aa21d6c8a6d9eb1a0576dbf354fe…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/9.10.3-backports] 15 commits: bump deepseq to 1.5.2.0
by Zubin (＠wz1000) 24 Jul '25
by Zubin (＠wz1000) 24 Jul '25
24 Jul '25
Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC
Commits:
9eefe6ba by Zubin Duggal at 2025-07-24T23:53:12+05:30
bump deepseq to 1.5.2.0
- - - - -
add840dc by Zubin Duggal at 2025-07-24T23:53:12+05:30
bump os-string to 2.0.7
- - - - -
b00be995 by Zubin Duggal at 2025-07-24T23:53:13+05:30
bump process to 1.6.26.1
- - - - -
f3d00969 by Zubin Duggal at 2025-07-24T23:53:13+05:30
bump unix to 2.8.7.0
- - - - -
b3899d42 by Jens Petersen at 2025-07-24T23:53:13+05:30
9.10 hadrian can build with Cabal-3.12.1
fixes #25605
(cherry picked from commit 07f17b6ed1bb0ba7134ee8dfd992036e97552c94)
- - - - -
3b1ef0ae by sheaf at 2025-07-24T23:53:13+05:30
Don't cache solved [W] HasCallStack constraints
This commit ensures we do not add solved Wanted constraints that mention
HasCallStack or HasExceptionContext constraints to the set of solved
Wanted dictionary constraints: caching them is invalid, because re-using
such cached dictionaries means using an old call-stack instead of
constructing a new one, as was reported in #25529.
Fixes #25529.
(cherry picked from commit 256ac29c8df4f17a1d50ea243408d506ebf395d6)
- - - - -
7492d007 by Zubin Duggal at 2025-07-24T23:53:13+05:30
In commit "Don't cache solved [W] HasCallStack constraints" (256ac29c8df4f17a1d50ea243408d506ebf395d6),
we attempt to use `tryM` to avoid errors when looking up certain known-key names like CallStack while
compiling ghc-prim and ghc-internal.
Unfortunately, `tryM` doesn't catch module lookup errors. This manifests as a failure to build ghc-prim
in `--make` mode on the GHC 9.10 branch.
Instead, we explicitly avoid doing lookups when we are compiling ghc-prim or ghc-internal instead of
relying on catching the exception.
- - - - -
ce5f1782 by Zubin Duggal at 2025-07-24T23:53:13+05:30
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
(cherry picked from commit 8d33d048dbe159a045a4c304fa92318365a3dfe2)
- - - - -
a54ae3d5 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
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.
(cherry picked from commit 2c73250494fd9f48ebda6d6fe72f0cd03182aff1)
- - - - -
ccd546a9 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Parse math even after ordinary characters
Fixes a bug where math sections were not recognized if preceded by a
character that isn't special (like space or a markup character).
(cherry picked from commit b790d647c1ccdcc9aa8f166c3e0e42d0a5c29625)
- - - - -
6c735ac2 by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Fix links to type operators
(cherry picked from commit a0adc30d892f14f543f39d5c45faccacbc28afb4)
- - - - -
68ce2fde by Ryan Hendrickson at 2025-07-24T23:53:13+05:30
haddock: Document instances from other packages
When attaching instances to `Interface`s, it isn't enough just to look
for instances in the list of `Interface`s being processed. We also need
to look in the modules on which they depend, including those outside of
this package.
Fixes #25147.
Fixes #26079.
(cherry picked from commit a26243fde4680271712a3d774e17f6cd6da4a652)
- - - - -
d23694b3 by Zubin Duggal at 2025-07-24T23:53:13+05:30
haddock: Don't warn about missing link destinations for derived names.
Fixes #26114
(cherry picked from commit 5dabc718a04bfc4d277c5ff7f815ee3d6b9670cb)
- - - - -
539a44bc by Zubin Duggal at 2025-07-24T23:53:13+05:30
Bump haddock version to 2.31.3
- - - - -
2c48d725 by Zubin Duggal at 2025-07-24T23:53:13+05:30
Prepare 9.10.3 prerelease
- - - - -
31 changed files:
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Types.hs
- configure.ac
- + docs/users_guide/9.10.3-notes.rst
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Builders/Ghc.hs
- libraries/deepseq
- libraries/os-string
- libraries/process
- libraries/unix
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/driver/T20604/T20604.stdout
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/static-plugins.stdout
- + testsuite/tests/simplCore/should_compile/T21391.stderr
- + testsuite/tests/typecheck/should_run/T25529.hs
- + testsuite/tests/typecheck/should_run/T25529.stdout
- testsuite/tests/typecheck/should_run/all.T
- utils/haddock
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c903b58277328bf21114a5918fc21c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c903b58277328bf21114a5918fc21c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
24 Jul '25
Rodrigo Mesquita pushed new branch wip/romes/26227 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/26227
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
e07ba567 by Simon Peyton Jones at 2025-07-24T17:44:04+01:00
More wibbles
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Exitify.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -39,7 +39,7 @@ module GHC.Core.Opt.Arity
-- ** Join points
- , etaExpandToJoinPoint, etaExpandToJoinPointRule
+ , etaExpandToJoinPoint, etaExpandToJoinPointRule, mkNewJoinPointBinding
-- ** Coercions and casts
, pushCoArg, pushCoArgs, pushCoValArg, pushCoTyArg
@@ -3168,6 +3168,16 @@ more elaborate stuff, but it'd involve substitution etc.
********************************************************************* -}
-------------------
+mkNewJoinPointBinding :: Id -> JoinArity -> CoreExpr -> (Id, CoreExpr)
+mkNewJoinPointBinding bndr join_arity rhs
+ = (join_bndr, mkLams join_lam_bndrs join_body)
+ where
+ (join_lam_bndrs, join_body) = etaExpandToJoinPoint join_arity rhs
+ str_sig = idDmdSig bndr
+ str_arity = count isId join_lam_bndrs -- Strictness demands are for Ids only
+ join_bndr = bndr `asJoinId` join_arity
+ `setIdDmdSig` etaConvertDmdSig str_arity str_sig
+
-- | Split an expression into the given number of binders and a body,
-- eta-expanding if necessary. Counts value *and* type binders.
etaExpandToJoinPoint :: JoinArity -> CoreExpr -> ([CoreBndr], CoreExpr)
=====================================
compiler/GHC/Core/Opt/Exitify.hs
=====================================
@@ -38,6 +38,7 @@ Now `t` is no longer in a recursive function, and good things happen!
import GHC.Prelude
import GHC.Builtin.Uniques
import GHC.Core
+import GHC.Core.Opt.Arity( mkNewJoinPointBinding )
import GHC.Core.Utils
import GHC.Core.FVs
import GHC.Core.Type
@@ -49,7 +50,7 @@ import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Basic( JoinPointHood(..) )
-import GHC.Utils.Monad.State.Strict
+import qualified GHC.Utils.Monad.State.Strict as S
import GHC.Utils.Misc( mapSnd, count )
import GHC.Data.FastString
@@ -105,7 +106,7 @@ exitifyProgram binds = map goTopLvl binds
-- | State Monad used inside `exitify`
-type ExitifyM = State [(JoinId, CoreExpr)]
+type ExitifyM = S.State [(JoinId, CoreExpr)]
-- | Given a recursive group of a joinrec, identifies “exit paths” and binds them as
-- join-points outside the joinrec.
@@ -121,7 +122,7 @@ exitifyRec in_scope pairs
-- Which are the recursive calls?
recursive_calls = mkVarSet $ map fst pairs
- (pairs',exits) = (`runState` []) $
+ (pairs',exits) = (`S.runState` []) $
forM ann_pairs $ \(x,rhs) -> do
-- go past the lambdas of the join point
let (args, body) = collectNAnnBndrs (idJoinArity x) rhs
@@ -262,28 +263,27 @@ exitifyRec in_scope pairs
captures_join_points = any isJoinId abs_vars
--- Picks a new unique, which is disjoint from
--- * the free variables of the whole joinrec
--- * any bound variables (captured)
--- * any exit join points created so far.
-mkExitJoinId :: InScopeSet -> Type -> JoinArity -> ExitifyM JoinId
-mkExitJoinId in_scope ty join_arity = do
- fs <- get
- let avoid = in_scope `extendInScopeSetList` (map fst fs)
- `extendInScopeSet` exit_id_tmpl -- just cosmetics
- return (uniqAway avoid exit_id_tmpl)
- where
- exit_id_tmpl = mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty
- `asJoinId` join_arity
-
addExit :: InScopeSet -> JoinArity -> CoreExpr -> ExitifyM JoinId
-addExit in_scope join_arity rhs = do
- -- Pick a suitable name
- let ty = exprType rhs
- v <- mkExitJoinId in_scope ty join_arity
- fs <- get
- put ((v,rhs):fs)
- return v
+addExit in_scope join_arity rhs
+ = do { fs <- S.get
+ ; let ty = exprType rhs
+ avoid = in_scope `extendInScopeSetList` (map fst fs)
+ `extendInScopeSet` exit_id1 -- just cosmetics
+ -- avoid: pick a new unique, that is disjoint from
+ -- * the free variables of the whole joinrec
+ -- * any bound variables (captured)
+ -- * any exit join points created so far (in `fs`)
+
+ exit_id1 = mkSysLocal (fsLit "exit") initExitJoinUnique ManyTy ty
+ exit_id2 = uniqAway avoid exit_id1
+
+ bind_pr@(exit_id3,_) = mkNewJoinPointBinding exit_id2 join_arity rhs
+ -- NB: mkNewJoinPointBinding does eta-expansion if needed,
+ -- to make sure that the join-point binding has the
+ -- right number of lambdas all lined up at the top
+
+ ; S.put (bind_pr : fs)
+ ; return exit_id3 }
{-
Note [Interesting expression]
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -742,21 +742,27 @@ Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3).
Note [Finding join points]
~~~~~~~~~~~~~~~~~~~~~~~~~~
It's the occurrence analyser's job to find bindings that we can turn into join
-points, but it doesn't perform that transformation right away. Rather, it marks
-the eligible bindings as part of their occurrence data, leaving it to the
-simplifier (or to simpleOptPgm) to actually change the binder's 'IdDetails'.
-The simplifier then eta-expands the RHS if needed and then updates the
-occurrence sites. Dividing the work this way means that the occurrence analyser
+points, but it doesn't /perform/ that transformation right away. Rather:
+
+* The occurrence analyser marks the eligible bindings as part of their
+ occurrence data. To track potential join points, we use the 'occ_tail' field of
+ OccInfo. A value of `AlwaysTailCalled n` indicates that every occurrence of
+ the variable is a tail call with `n` arguments (counting both value and type
+ arguments). Otherwise `occ_tail` will be 'NoTailCallInfo'. The tail call info
+ flows bottom-up with the rest of `OccInfo` until it goes on the binder.
+
+* The simplifier (or simpleOptPgm) then
+ * Spots join points from that AlwaysTailCalled OccInfo
+ * Eta-expands the RHS if needed
+ * Changes the binder's `IdDetails`
+ * Updates the occurrence sites
+ The first three steps are done by GHC.Core.Opt.SimpleOpt.joinPointBinding_maybe.
+
+Dividing the work this way means that the occurrence analyser
still only takes one pass, yet one can always tell the difference between a
function call and a jump by looking at the occurrence (because the same pass
changes the 'IdDetails' and propagates the binders to their occurrence sites).
-To track potential join points, we use the 'occ_tail' field of OccInfo. A value
-of `AlwaysTailCalled n` indicates that every occurrence of the variable is a
-tail call with `n` arguments (counting both value and type arguments). Otherwise
-'occ_tail' will be 'NoTailCallInfo'. The tail call info flows bottom-up with the
-rest of 'OccInfo' until it goes on the binder.
-
Note [Join arity prediction based on joinRhsArity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In general, the join arity from tail occurrences of a join point (O) may be
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -42,7 +42,7 @@ import GHC.Types.Id.Info ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, Id
import GHC.Types.Var ( isNonCoVarId, setTyVarUnfolding, tyVarOccInfo )
import GHC.Types.Var.Set
import GHC.Types.Var.Env
-import GHC.Types.Demand( etaConvertDmdSig, topSubDmd )
+import GHC.Types.Demand( topSubDmd )
import GHC.Types.Tickish
import GHC.Types.Basic
@@ -998,12 +998,7 @@ joinPointBinding_maybe bndr rhs
= Just (bndr, rhs)
| AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)
- , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs
- , let str_sig = idDmdSig bndr
- str_arity = count isId bndrs -- Strictness demands are for Ids only
- join_bndr = bndr `asJoinId` join_arity
- `setIdDmdSig` etaConvertDmdSig str_arity str_sig
- = Just (join_bndr, mkLams bndrs body)
+ = Just (mkNewJoinPointBinding bndr join_arity rhs)
| otherwise
= Nothing
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -3121,25 +3121,20 @@ mkPolyAbsLams :: (b -> AbsVar, Var -> b -> b)
-- use it for both CoreExpr and LevelledExpr
{-# INLINE mkPolyAbsLams #-}
mkPolyAbsLams (get,set) bndrs body
- = go emptyVarSet [] bndrs
+ = go bndrs
where
- go _ tv_binds []
- = mkLets (reverse tv_binds) body
- go tvs tv_binds (bndr:bndrs)
+ go [] = body
+ go (bndr:bndrs)
| Just ty <- tyVarUnfolding_maybe var
- = go (tvs `extendVarSet` var) (NonRec bndr (Type ty) : tv_binds) bndrs
+ = Let (NonRec bndr (Type ty)) $
+ go bndrs
| otherwise
- = Lam bndr' (go tvs tv_binds bndrs)
+ = Lam bndr' (go bndrs)
where
var = get bndr
- var' = updateVarType (expandTyVarUnfoldings tvs) $
- zap_unfolding var
- bndr' | isEmptyVarSet tvs = bndr
- | otherwise = set var' bndr
-
-- zap: We are going to lambda-abstract, so nuke any IdInfo
- zap_unfolding var | isId var = setIdInfo var vanillaIdInfo
- | otherwise = var
+ bndr' | isId var = set (setIdInfo var vanillaIdInfo) bndr
+ | otherwise = bndr
mkCoreAbsLams :: AbsVars -> CoreExpr -> CoreExpr
-- Specialise for CoreExpr
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -819,21 +819,17 @@ cpeRhsE :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
-- For example
-- f (g x) ===> ([v = g x], f v)
-cpeRhsE env (Type ty)
- = return (emptyFloats, Type (cpSubstTy env ty))
-cpeRhsE env (Coercion co)
- = return (emptyFloats, Coercion (cpSubstCo env co))
-cpeRhsE env expr@(Lit lit)
- | LitNumber LitNumBigNat i <- lit
- = cpeBigNatLit env i
- | otherwise = return (emptyFloats, expr)
+cpeRhsE env (Type ty) = return (emptyFloats, Type (cpSubstTy env ty))
+cpeRhsE env (Coercion co) = return (emptyFloats, Coercion (cpSubstCo env co))
cpeRhsE env expr@(Var {}) = cpeApp env expr
cpeRhsE env expr@(App {}) = cpeApp env expr
+cpeRhsE env expr@(Lit lit)
+ = case lit of
+ LitNumber LitNumBigNat i -> cpeBigNatLit env i
+ _ -> return (emptyFloats, expr)
+
cpeRhsE env (Let bind body)
- | isTypeBind bind
- = cpeRhsE env body
- | otherwise
= do { (env', bind_floats, maybe_bind') <- cpeBind NotTopLevel env bind
; (body_floats, body') <- cpeRhsE env' body
; let expr' = case maybe_bind' of Just bind' -> Let bind' body'
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07ba56779070070fec3691e3aa7247…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e07ba56779070070fec3691e3aa7247…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/9.10.3-backports] 11 commits: 9.10 hadrian can build with Cabal-3.12.1
by Zubin (＠wz1000) 24 Jul '25
by Zubin (＠wz1000) 24 Jul '25
24 Jul '25
Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC
Commits:
e61cf95b by Jens Petersen at 2025-07-24T19:58:47+05:30
9.10 hadrian can build with Cabal-3.12.1
fixes #25605
(cherry picked from commit 07f17b6ed1bb0ba7134ee8dfd992036e97552c94)
- - - - -
70aaec05 by sheaf at 2025-07-24T19:58:47+05:30
Don't cache solved [W] HasCallStack constraints
This commit ensures we do not add solved Wanted constraints that mention
HasCallStack or HasExceptionContext constraints to the set of solved
Wanted dictionary constraints: caching them is invalid, because re-using
such cached dictionaries means using an old call-stack instead of
constructing a new one, as was reported in #25529.
Fixes #25529.
(cherry picked from commit 256ac29c8df4f17a1d50ea243408d506ebf395d6)
- - - - -
7ad8db1e by Zubin Duggal at 2025-07-24T19:58:47+05:30
In commit "Don't cache solved [W] HasCallStack constraints" (256ac29c8df4f17a1d50ea243408d506ebf395d6),
we attempt to use `tryM` to avoid errors when looking up certain known-key names like CallStack while
compiling ghc-prim and ghc-internal.
Unfortunately, `tryM` doesn't catch module lookup errors. This manifests as a failure to build ghc-prim
in `--make` mode on the GHC 9.10 branch.
Instead, we explicitly avoid doing lookups when we are compiling ghc-prim or ghc-internal instead of
relying on catching the exception.
- - - - -
b7196825 by Zubin Duggal at 2025-07-24T19:58:47+05:30
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
(cherry picked from commit 8d33d048dbe159a045a4c304fa92318365a3dfe2)
- - - - -
5b88b915 by Ryan Hendrickson at 2025-07-24T19:58:47+05:30
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.
(cherry picked from commit 2c73250494fd9f48ebda6d6fe72f0cd03182aff1)
- - - - -
2e84dfa4 by Ryan Hendrickson at 2025-07-24T19:58:47+05:30
haddock: Parse math even after ordinary characters
Fixes a bug where math sections were not recognized if preceded by a
character that isn't special (like space or a markup character).
(cherry picked from commit b790d647c1ccdcc9aa8f166c3e0e42d0a5c29625)
- - - - -
556f0dc3 by Ryan Hendrickson at 2025-07-24T19:58:47+05:30
haddock: Fix links to type operators
(cherry picked from commit a0adc30d892f14f543f39d5c45faccacbc28afb4)
- - - - -
2ede5825 by Ryan Hendrickson at 2025-07-24T19:58:47+05:30
haddock: Document instances from other packages
When attaching instances to `Interface`s, it isn't enough just to look
for instances in the list of `Interface`s being processed. We also need
to look in the modules on which they depend, including those outside of
this package.
Fixes #25147.
Fixes #26079.
(cherry picked from commit a26243fde4680271712a3d774e17f6cd6da4a652)
- - - - -
4e7df33d by Zubin Duggal at 2025-07-24T19:58:47+05:30
haddock: Don't warn about missing link destinations for derived names.
Fixes #26114
(cherry picked from commit 5dabc718a04bfc4d277c5ff7f815ee3d6b9670cb)
- - - - -
afbc5c28 by Zubin Duggal at 2025-07-24T19:58:47+05:30
Bump haddock version to 2.31.3
- - - - -
c903b582 by Zubin Duggal at 2025-07-24T19:58:47+05:30
Prepare 9.10.3 prerelease
- - - - -
26 changed files:
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Types.hs
- configure.ac
- + docs/users_guide/9.10.3-notes.rst
- hadrian/hadrian.cabal
- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Builders/Ghc.hs
- testsuite/driver/testlib.py
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- testsuite/tests/driver/T20604/T20604.stdout
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/static-plugins.stdout
- + testsuite/tests/typecheck/should_run/T25529.hs
- + testsuite/tests/typecheck/should_run/T25529.stdout
- testsuite/tests/typecheck/should_run/all.T
- utils/haddock
Changes:
=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.Core.Predicate (
-- Implicit parameters
isIPLikePred, mentionsIP, isIPTyCon, isIPClass,
isCallStackTy, isCallStackPred, isCallStackPredTy,
- isExceptionContextPred,
+ isExceptionContextPred, isExceptionContextTy,
isIPPred_maybe,
-- Evidence variables
@@ -39,7 +39,6 @@ import GHC.Prelude
import GHC.Core.Type
import GHC.Core.Class
-import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.TyCon
import GHC.Core.TyCon.RecWalk
import GHC.Types.Var
@@ -292,7 +291,7 @@ isExceptionContextPred cls tys
| otherwise
= Nothing
--- | Is a type a 'CallStack'?
+-- | Is a type an 'ExceptionContext'?
isExceptionContextTy :: Type -> Bool
isExceptionContextTy ty
| Just tc <- tyConAppTyCon_maybe ty
@@ -338,31 +337,38 @@ isCallStackTy ty
isIPLikePred :: Type -> Bool
-- Is `pred`, or any of its superclasses, an implicit parameter?
-- See Note [Local implicit parameters]
-isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred
-
-mentionsIP :: Type -> Class -> [Type] -> Bool
--- Is (cls tys) an implicit parameter with key `str_ty`, or
--- is any of its superclasses such at thing.
+isIPLikePred pred =
+ mentions_ip_pred initIPRecTc (const True) (const True) pred
+
+mentionsIP :: (Type -> Bool) -- ^ predicate on the string
+ -> (Type -> Bool) -- ^ predicate on the type
+ -> Class
+ -> [Type] -> Bool
+-- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if:
+--
+-- - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@
+-- are both @True@,
+-- - or any superclass of @cls tys@ has this property.
+--
-- See Note [Local implicit parameters]
-mentionsIP str_ty cls tys = mentions_ip initIPRecTc (Just str_ty) cls tys
-
-mentions_ip :: RecTcChecker -> Maybe Type -> Class -> [Type] -> Bool
-mentions_ip rec_clss mb_str_ty cls tys
- | Just (str_ty', _) <- isIPPred_maybe cls tys
- = case mb_str_ty of
- Nothing -> True
- Just str_ty -> str_ty `eqType` str_ty'
+mentionsIP = mentions_ip initIPRecTc
+
+mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool
+mentions_ip rec_clss str_cond ty_cond cls tys
+ | Just (str_ty, ty) <- isIPPred_maybe cls tys
+ = str_cond str_ty && ty_cond ty
| otherwise
- = or [ mentions_ip_pred rec_clss mb_str_ty (classMethodInstTy sc_sel_id tys)
+ = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys)
| sc_sel_id <- classSCSelIds cls ]
-mentions_ip_pred :: RecTcChecker -> Maybe Type -> Type -> Bool
-mentions_ip_pred rec_clss mb_str_ty ty
+
+mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool
+mentions_ip_pred rec_clss str_cond ty_cond ty
| Just (cls, tys) <- getClassPredTys_maybe ty
, let tc = classTyCon cls
, Just rec_clss' <- if isTupleTyCon tc then Just rec_clss
else checkRecTc rec_clss tc
- = mentions_ip rec_clss' mb_str_ty cls tys
+ = mentions_ip rec_clss' str_cond ty_cond cls tys
| otherwise
= False -- Includes things like (D []) where D is
-- a Constraint-ranged family; #7785
@@ -429,7 +435,38 @@ Small worries (Sept 20):
* The superclass hunt stops when it encounters the same class again,
but in principle we could have the same class, differently instantiated,
and the second time it could have an implicit parameter
-I'm going to treat these as problems for another day. They are all exotic. -}
+I'm going to treat these as problems for another day. They are all exotic.
+
+Note [Using typesAreApart when calling mentionsIP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We call 'mentionsIP' in two situations:
+
+ (1) to check that a predicate does not contain any implicit parameters
+ IP str ty, for a fixed literal str and any type ty,
+ (2) to check that a predicate does not contain any HasCallStack or
+ HasExceptionContext constraints.
+
+In both of these cases, we want to be sure, so we should be conservative:
+
+ For (1), the predicate might contain an implicit parameter IP Str a, where
+ Str is a type family such as:
+
+ type family MyStr where MyStr = "abc"
+
+ To safeguard against this (niche) situation, instead of doing a simple
+ type equality check, we use 'typesAreApart'. This allows us to recognise
+ that 'IP MyStr a' contains an implicit parameter of the form 'IP "abc" ty'.
+
+ For (2), we similarly might have
+
+ type family MyCallStack where MyCallStack = CallStack
+
+ Again, here we use 'typesAreApart'. This allows us to see that
+
+ (?foo :: MyCallStack)
+
+ is indeed a CallStack constraint, hidden under a type family.
+-}
{- *********************************************************************
* *
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -2659,6 +2659,7 @@ tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta tc@(TyCon { tyConDetails = details })
| AlgTyCon {algTcStupidTheta = stupid} <- details = stupid
| PrimTyCon {} <- details = []
+ | PromotedDataCon {} <- details = []
| otherwise = pprPanic "tyConStupidTheta" (ppr tc)
-- | Extract the 'TyVar's bound by a vanilla type synonym
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -32,7 +32,7 @@ import GHC.Core.InstEnv ( DFunInstType )
import GHC.Core.Class
import GHC.Core.Predicate
import GHC.Core.Multiplicity ( scaledThing )
-import GHC.Core.Unify ( ruleMatchTyKiX )
+import GHC.Core.Unify ( ruleMatchTyKiX , typesAreApart )
import GHC.Types.Name
import GHC.Types.Name.Set
@@ -105,21 +105,25 @@ updInertDicts :: DictCt -> TcS ()
updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys })
= do { traceTcS "Adding inert dict" (ppr dict_ct $$ ppr cls <+> ppr tys)
- ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys
+ ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys
-> -- See (SIP1) and (SIP2) in Note [Shadowing of implicit parameters]
-- Update /both/ inert_cans /and/ inert_solved_dicts.
updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) ->
- inerts { inert_cans = updDicts (filterDicts (not_ip_for str_ty)) ics
- , inert_solved_dicts = filterDicts (not_ip_for str_ty) solved }
- | otherwise
+ inerts { inert_cans = updDicts (filterDicts (does_not_mention_ip_for str_ty)) ics
+ , inert_solved_dicts = filterDicts (does_not_mention_ip_for str_ty) solved }
+ | otherwise
-> return ()
-- Add the new constraint to the inert set
; updInertCans (updDicts (addDict dict_ct)) }
where
- not_ip_for :: Type -> DictCt -> Bool
- not_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys })
- = not (mentionsIP str_ty cls tys)
+ -- Does this class constraint or any of its superclasses mention
+ -- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'?
+ does_not_mention_ip_for :: Type -> DictCt -> Bool
+ does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys })
+ = not $ mentionsIP (not . typesAreApart str_ty) (const True) cls tys
+ -- See Note [Using typesAreApart when calling mentionsIP]
+ -- in GHC.Core.Predicate
canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt
-- Once-only processing of Dict constraints:
@@ -201,7 +205,7 @@ in two places:
* In `GHC.Tc.Solver.InertSet.solveOneFromTheOther`, be careful when we have
(?x :: ty) in the inert set and an identical (?x :: ty) as the work item.
-* In `updInertDicts` in this module, when adding [G] (?x :: ty), remove any
+* In `updInertDicts`, in this module, when adding [G] (?x :: ty), remove any
existing [G] (?x :: ty'), regardless of ty'.
* Wrinkle (SIP1): we must be careful of superclasses. Consider
@@ -221,7 +225,7 @@ in two places:
An important special case is constraint tuples like [G] (% ?x::ty, Eq a %).
But it could happen for `class xx => D xx where ...` and the constraint D
(?x :: int). This corner (constraint-kinded variables instantiated with
- implicit parameter constraints) is not well explorered.
+ implicit parameter constraints) is not well explored.
Example in #14218, and #23761
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -158,7 +158,7 @@ import GHC.Tc.Types.Origin
import GHC.Tc.Types.Constraint
import GHC.Tc.Utils.Unify
-import GHC.Builtin.Names ( unsatisfiableClassNameKey )
+import GHC.Builtin.Names ( unsatisfiableClassNameKey, callStackTyConName, exceptionContextTyConName )
import GHC.Core.Type
import GHC.Core.TyCo.Rep as Rep
@@ -168,6 +168,7 @@ import GHC.Core.Predicate
import GHC.Core.Reduction
import GHC.Core.Class
import GHC.Core.TyCon
+import GHC.Core.Unify (typesAreApart)
import GHC.Types.Name
import GHC.Types.TyThing
@@ -177,13 +178,13 @@ import GHC.Types.Var.Set
import GHC.Types.Unique.Supply
import GHC.Types.Unique.Set( elementOfUniqSet )
-import GHC.Unit.Module ( HasModule, getModule, extractModule )
+import GHC.Unit.Module ( HasModule, getModule, extractModule, primUnit, moduleUnit, ghcInternalUnit, bignumUnit)
import qualified GHC.Rename.Env as TcM
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Logger
-import GHC.Utils.Misc (HasDebugCallStack)
+import GHC.Utils.Misc (HasDebugCallStack, (<||>))
import GHC.Data.Bag as Bag
import GHC.Data.Pair
@@ -478,14 +479,92 @@ getSafeOverlapFailures
updSolvedDicts :: InstanceWhat -> DictCt -> TcS ()
-- Conditionally add a new item in the solved set of the monad
-- See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet
-updSolvedDicts what dict_ct@(DictCt { di_ev = ev })
+updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev })
| isWanted ev
, instanceReturnsDictCon what
- = do { traceTcS "updSolvedDicts:" $ ppr dict_ct
+ = do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName
+ ; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName
+ ; let contains_callstack_or_exceptionCtx =
+ mentionsIP
+ (const True)
+ -- NB: the name of the call-stack IP is irrelevant
+ -- e.g (?foo :: CallStack) counts!
+ (is_callstack <||> is_exceptionCtx)
+ cls tys
+ -- See Note [Don't add HasCallStack constraints to the solved set]
+ ; unless contains_callstack_or_exceptionCtx $
+ do { traceTcS "updSolvedDicts:" $ ppr dict_ct
; updInertSet $ \ ics ->
- ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) } }
+ ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) }
+ } }
| otherwise
= return ()
+ where
+
+ -- Return a predicate that decides whether a type is CallStack
+ -- or ExceptionContext, accounting for e.g. type family reduction, as
+ -- per Note [Using typesAreApart when calling mentionsIP].
+ --
+ -- See Note [Using isCallStackTy in mentionsIP].
+ is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool)
+ is_tyConTy is_eq tc_name
+ = do { mb_tc <- wrapTcS $ do
+ mod <- tcg_mod <$> TcM.getGblEnv
+ if moduleUnit mod `elem` [primUnit, ghcInternalUnit, bignumUnit]
+ then return Nothing
+ else Just <$> TcM.tcLookupTyCon tc_name
+ ; case mb_tc of
+ Just tc ->
+ return $ \ ty -> not (typesAreApart ty (mkTyConTy tc))
+ Nothing ->
+ return is_eq
+ }
+
+{- Note [Don't add HasCallStack constraints to the solved set]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must not add solved Wanted dictionaries that mention HasCallStack constraints
+to the solved set, or we might fail to accumulate the proper call stack, as was
+reported in #25529.
+
+Recall that HasCallStack constraints (and the related HasExceptionContext
+constraints) are implicit parameter constraints, and are accumulated as per
+Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence.
+
+When we solve a Wanted that contains a HasCallStack constraint, we don't want
+to cache the result, because re-using that solution means re-using the call-stack
+in a different context!
+
+See also Note [Shadowing of implicit parameters], which deals with a similar
+problem with Given implicit parameter constraints.
+
+Note [Using isCallStackTy in mentionsIP]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To implement Note [Don't add HasCallStack constraints to the solved set],
+we need to check whether a constraint contains a HasCallStack or HasExceptionContext
+constraint. We do this using the 'mentionsIP' function, but as per
+Note [Using typesAreApart when calling mentionsIP] we don't want to simply do:
+
+ mentionsIP
+ (const True) -- (ignore the implicit parameter string)
+ (isCallStackTy <||> isExceptionContextTy)
+
+because this does not account for e.g. a type family that reduces to CallStack.
+The predicate we want to use instead is:
+
+ \ ty -> not (typesAreApart ty callStackTy && typesAreApart ty exceptionContextTy)
+
+However, this is made difficult by the fact that CallStack and ExceptionContext
+are not wired-in types; they are only known-key. This means we must look them
+up using 'tcLookupTyCon'. However, this might fail, e.g. if we are in the middle
+of typechecking ghc-internal and these data-types have not been typechecked yet!
+
+In that case, we simply fall back to the naive 'isCallStackTy'/'isExceptionContextTy'
+logic.
+
+Note that it would be somewhat painful to wire-in ExceptionContext: at the time
+of writing (March 2025), this would require wiring in the ExceptionAnnotation
+class, as well as SomeExceptionAnnotation, which is a data type with existentials.
+-}
getSolvedDicts :: TcS (DictMap DictCt)
getSolvedDicts = do { ics <- getInertSet; return (inert_solved_dicts ics) }
=====================================
compiler/GHC/Tc/Solver/Types.hs
=====================================
@@ -166,7 +166,7 @@ Suppose f :: HasCallStack => blah. Then
IP "callStack" CallStack
See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
-* We cannonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by
+* We canonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by
pushing the call-site info on the stack, and changing the CtOrigin
to record that has been done.
Bind: s1 = pushCallStack <site-info> s2
=====================================
configure.ac
=====================================
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.10.2], [glasgow-ha
AC_CONFIG_MACRO_DIRS([m4])
# Set this to YES for a released version, otherwise NO
-: ${RELEASE=YES}
+: ${RELEASE=NO}
# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
# above. If this is not a released version, then we will append the
=====================================
docs/users_guide/9.10.3-notes.rst
=====================================
@@ -0,0 +1,165 @@
+.. _release-9-10-3:
+
+Version 9.10.3
+===============
+The significant changes to the various parts of the compiler are listed in the
+following sections. See the `migration guide
+<https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.10>`_ on the GHC Wiki
+for specific guidance on migrating programs to this release.
+
+
+Compiler
+~~~~~~~~
+
+- Don't cache solved [W] HasCallStack constraints to avoid re-using old
+ call-stacks instead of constructing new ones. (:ghc-ticket:`25529`)
+
+- Fix EmptyCase panic in tcMatches when \case{} is checked against a function
+ type preceded by invisible forall. (:ghc-ticket:`25960`)
+
+- Fix panic triggered by combination of \case{} and forall t ->. (:ghc-ticket:`25004`)
+
+- Fix GHC.SysTools.Ar archive member size writing logic that was emitting wrong
+ archive member sizes in headers. (:ghc-ticket:`26120`, :ghc-ticket:`22586`)
+
+- Fix multiple bugs in name resolution of subordinate import lists related to
+ type namespace specifiers and hiding clauses. (:ghc-ticket:`22581`, :ghc-ticket:`25983`, :ghc-ticket:`25984`, :ghc-ticket:`25991`)
+
+- Use mkTrAppChecked in ds_ev_typeable to avoid false negatives for type
+ equality involving function types. (:ghc-ticket:`25998`)
+
+- Fix bytecode generation for ``tagToEnum# <LITERAL>``. (:ghc-ticket:`25975`)
+
+- Don't report used duplicate record fields as unused. (:ghc-ticket:`24035`)
+
+- Propagate long distance info to guarded let binds for better pattern-match
+ checking warnings. (:ghc-ticket:`25749`)
+
+- Prevent incorrect unpacking optimizations for GADTs with multiple constructors. (:ghc-ticket:`25672`)
+
+- Introduce a separate argument limit for forced specs via SPEC argument with
+ warning when limit is exceeded. (:ghc-ticket:`25197`)
+
+Build system and packaging
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+- 9.10 hadrian can build with Cabal-3.12.1. (:ghc-ticket:`25605`)
+
+- GHC settings: always unescape escaped spaces to fix handling of spaces in
+ executable paths. (:ghc-ticket:`25204`)
+
+Native code generator backend
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+- x86 NCG: Fix code generation of bswap64 on i386. (:ghc-ticket:`25601`)
+
+- AArch64 NCG: Fix sub-word arithmetic right shift by zero-extending sub-word
+ values. (:ghc-ticket:`26061`)
+
+- NCG: AArch64 - Add -finter-module-far-jumps flag for modules with far jumps
+ outside the current module. (:ghc-ticket:`24648`)
+
+LLVM backend
+~~~~~~~~~~~~
+
+- LLVM: fix typo in padLiveArgs that was incorrectly computing too many padding
+ registers causing segfaults. (:ghc-ticket:`25770`, :ghc-ticket:`25773`)
+
+- llvmGen: Fix linkage of built-in arrays to use Appending linkage instead of
+ Internal. (:ghc-ticket:`25769`)
+
+- llvmGen: Fix built-in variable predicate to check for `@llvm` rather than
+ `$llvm`.
+
+WebAssembly backend
+~~~~~~~~~~~~~~~~~~~
+
+- wasm: use primitive opcodes for fabs and sqrt operations.
+
+Runtime system
+~~~~~~~~~~~~~~
+
+- rts: Implement WEAK EXTERNAL undef redirection by target symbol name.
+
+- rts: Handle API set symbol versioning conflicts.
+
+- rts: fix rts_clearMemory logic when sanity checks are enabled. (:ghc-ticket:`26011`)
+
+- rts/linker: Improve efficiency of proddable blocks structure by using binary
+ search instead of linked lists for better performance with split sections. (:ghc-ticket:`26009`)
+
+- rts/linker/PEi386: Don't repeatedly load DLLs by maintaining a hash-set of
+ loaded DLL names. (:ghc-ticket:`26009`, :ghc-ticket:`26052`)
+
+- rts/linker: Don't fail due to RTLD_NOW by attempting eager binding first,
+ then reverting to lazy binding on failure. (:ghc-ticket:`25943`)
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- base: Expose Backtraces constructor and fields. (:ghc-ticket:`26049`)
+
+- base: Note strictness changes made in 4.16.0.0. (:ghc-ticket:`25886`)
+
+- Fix bugs in ``integerRecipMod`` and ``integerPowMod`` return values. (:ghc-ticket:`26017`)
+
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+- perf: Replace uses of genericLength with strictGenericLength to reduce time
+ spent in 'assembleBCOs' and allocations. (:ghc-ticket:`25706`)
+
+Build tools
+~~~~~~~~~~~
+
+- configure: Drop probing of ld.gold since `gold` has been dropped from
+ binutils-2.44. (:ghc-ticket:`25716`)
+
+- get-win32-tarballs.py: List tarball files to be downloaded if we cannot find
+ them. (:ghc-ticket:`25929`)
+
+- hp2ps Utilities.c: include stdlib.h instead of extern malloc and realloc.
+
+Included libraries
+~~~~~~~~~~~~~~~~~~
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
\ No newline at end of file
=====================================
hadrian/hadrian.cabal
=====================================
@@ -152,7 +152,7 @@ executable hadrian
, TypeOperators
other-extensions: MultiParamTypeClasses
, TypeFamilies
- build-depends: Cabal >= 3.10 && < 3.11
+ build-depends: Cabal (>= 3.10 && < 3.11) || (>= 3.12.1 && < 3.13)
, base >= 4.11 && < 5
, bytestring >= 0.10 && < 0.13
, containers >= 0.5 && < 0.8
=====================================
hadrian/src/Context.hs
=====================================
@@ -9,7 +9,7 @@ module Context (
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
pkgLibraryFile, pkgGhciLibraryFile,
- pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir,
+ pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir, distDynDir,
haddockStatsFilesDir
) where
@@ -20,7 +20,8 @@ import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting
import GHC.Toolchain.Target (Target(..))
-import GHC.Platform.ArchOS
+import Hadrian.Oracles.Cabal
+import Hadrian.Haskell.Cabal.Type
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
@@ -62,12 +63,15 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))
--
-- We preform some renaming to accommodate Cabal's slightly different naming
-- conventions (see 'cabalOsString' and 'cabalArchString').
-distDir :: Stage -> Action FilePath
-distDir st = do
- version <- ghcVersionStage st
- targetOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st
- targetArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st
- return $ targetArch ++ "-" ++ targetOs ++ "-ghc-" ++ version
+distDir :: Context -> Action FilePath
+distDir c = do
+ cd <- readContextData c
+ return (contextLibdir cd)
+
+distDynDir :: Context -> Action FilePath
+distDynDir c = do
+ cd <- readContextData c
+ return (contextDynLibdir cd)
pkgFileName :: Context -> Package -> String -> String -> Action FilePath
pkgFileName context package prefix suffix = do
@@ -104,13 +108,12 @@ pkgHaddockFile Context {..} = do
-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
pkgRegisteredLibraryFile :: Context -> Action FilePath
pkgRegisteredLibraryFile context@Context {..} = do
- libDir <- libPath context
- pkgId <- pkgUnitId stage package
fileName <- pkgRegisteredLibraryFileName context
- distDir <- distDir stage
+ distDir <- distDir context
+ distDynDir <- distDynDir context
return $ if Dynamic `wayUnit` way
- then libDir -/- distDir -/- fileName
- else libDir -/- distDir -/- pkgId -/- fileName
+ then distDynDir -/- fileName
+ else distDir -/- fileName
-- | Just the final filename portion of pkgRegisteredLibraryFile
pkgRegisteredLibraryFileName :: Context -> Action FilePath
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -254,6 +254,7 @@ resolveContextData context@Context {..} = do
pdi <- liftIO $ getHookedBuildInfo [pkgPath package, cPath -/- "build"]
let pd' = C.updatePackageDescription pdi (C.localPkgDescr lbi)
lbi' = lbi { C.localPkgDescr = pd' }
+ pkgDbPath <- packageDbPath (PackageDbLoc stage iplace)
-- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations
-- See: https://github.com/snowleopard/hadrian/issues/548
@@ -302,6 +303,8 @@ resolveContextData context@Context {..} = do
| takeExtension fp `elem` [".cpp", ".cxx", ".c++"]= CppMain
| otherwise = CMain
+ install_dirs = absoluteInstallDirs pd' lbi' (CopyToDb pkgDbPath)
+
main_src = fmap (first C.display) mainIs
cdata = ContextData
{ dependencies = deps
@@ -343,7 +346,10 @@ resolveContextData context@Context {..} = do
, depLdOpts = forDeps Installed.ldOptions
, buildGhciLib = C.withGHCiLib lbi'
, frameworks = C.frameworks buildInfo
- , packageDescription = pd' }
+ , packageDescription = pd'
+ , contextLibdir = libdir install_dirs
+ , contextDynLibdir = dynlibdir install_dirs
+ }
in return cdata
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Type.hs
=====================================
@@ -70,6 +70,10 @@ data ContextData = ContextData
, buildGhciLib :: Bool
, frameworks :: [String]
, packageDescription :: PackageDescription
+ -- The location where normal library files go
+ , contextLibdir :: FilePath
+ -- The location where dynamic libraries go
+ , contextDynLibdir :: FilePath
} deriving (Eq, Generic, Show, Typeable)
instance Binary PackageData
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -1,8 +1,6 @@
{-# LANGUAGE TupleSections, MultiWayIf #-}
module Rules.BinaryDist where
-import Hadrian.Haskell.Cabal
-
import CommandLine
import Context
import Expression
@@ -146,15 +144,12 @@ bindistRules = do
phony "binary-dist-dir" $ do
version <- setting ProjectVersion
targetPlatform <- setting TargetPlatformFull
- distDir <- Context.distDir Stage1
- rtsDir <- pkgUnitId Stage1 rts
- -- let rtsDir = "rts"
+ distDir <- Context.distDir (vanillaContext Stage1 rts)
let ghcBuildDir = root -/- stageString Stage1
bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty
ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform
- rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
- -/- "include"
+ rtsIncludeDir = distDir -/- "include"
-- We 'need' all binaries and libraries
all_pkgs <- stagePackages Stage1
=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -10,7 +10,6 @@ import Utilities
import qualified System.Directory.Extra as IO
import Data.Either
import Rules.BinaryDist
-import Hadrian.Haskell.Cabal (pkgUnitId)
import Oracles.Setting
{-
@@ -53,13 +52,10 @@ cabalBuildRules = do
iserv_targets <- if cross then pure [] else iservBins
need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))
- distDir <- Context.distDir Stage1
- rtsDir <- pkgUnitId Stage1 rts
+ distDir <- Context.distDir (vanillaContext Stage1 rts)
-- let rtsDir = "rts"
- let ghcBuildDir = root -/- stageString Stage1
- rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
- -/- "include"
+ let rtsIncludeDir = distDir -/- "include"
libdir <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1
work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal"
=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -182,11 +182,12 @@ buildConfFinal rs context@Context {..} _conf = do
--
-- so that if any change ends up modifying a library (but not its .conf
-- file), we still rebuild things that depend on it.
- dir <- (-/-) <$> libPath context <*> distDir stage
+ dir <- distDir context
+ dyndir <- distDynDir context
pkgid <- pkgUnitId stage package
files <- liftIO $
- (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"]
- <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"]
+ (++) <$> getDirectoryFilesIO "." [dyndir -/- "*libHS"++pkgid++"*"]
+ <*> getDirectoryFilesIO "." [dir -/- "**"]
produces files
buildConfInplace :: [(Resource, Int)] -> Context -> FilePath -> Action ()
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -154,10 +154,9 @@ needRtsSymLinks :: Stage -> Set.Set Way -> Action ()
needRtsSymLinks stage rtsWays
= forM_ (Set.filter (wayUnit Dynamic) rtsWays) $ \ way -> do
let ctx = Context stage rts way Final
- libPath <- libPath ctx
- distDir <- distDir stage
+ distDir <- distDynDir ctx
rtsLibFile <- takeFileName <$> pkgLibraryFile ctx
- need [removeRtsDummyVersion (libPath </> distDir </> rtsLibFile)]
+ need [removeRtsDummyVersion (distDir </> rtsLibFile)]
prefix, versionlessPrefix :: String
versionlessPrefix = "libHSrts"
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -98,9 +98,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
-- Relative path from the output (rpath $ORIGIN).
originPath <- dropFileName <$> getOutput
context <- getContext
- libPath' <- expr (libPath context)
- st <- getStage
- distDir <- expr (Context.distDir st)
+ distPath <- expr (Context.distDynDir context)
useSystemFfi <- expr (flag UseSystemFfi)
buildPath <- getBuildPath
@@ -112,7 +110,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
let
dynamic = Dynamic `wayUnit` way
- distPath = libPath' -/- distDir
originToLibsDir = makeRelativeNoSysLink originPath distPath
rpath
-- Programs will end up in the bin dir ($ORIGIN) and will link to
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1493,7 +1493,7 @@ async def do_test(name: TestName,
dst_makefile = in_testdir('Makefile')
if src_makefile.exists():
makefile = src_makefile.read_text(encoding='UTF-8')
- makefile = re.sub('TOP=.*', 'TOP=%s' % config.top, makefile, 1)
+ makefile = re.sub('TOP=.*', 'TOP=%s' % config.top, makefile, count=1)
dst_makefile.write_text(makefile, encoding='UTF-8')
if opts.pre_cmd:
=====================================
testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
=====================================
@@ -13,13 +13,13 @@ Building library 'q' instantiated with
for bkpcabal08-0.1.0.0...
[2 of 4] Compiling B[sig] ( q/B.hsig, nothing )
[3 of 4] Compiling M ( q/M.hs, nothing ) [A changed]
-[4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p
+[4 of 4] Instantiating bkpcabal08-0.1.0.0-Asivy2QkF0WEbGENiw5nyj-p
Preprocessing library 'q' for bkpcabal08-0.1.0.0...
Building library 'q' instantiated with
- A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A
- B = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:B
+ A = bkpcabal08-0.1.0.0-BznDTmYyvWf7fdEdPEncB4-impl:A
+ B = bkpcabal08-0.1.0.0-BznDTmYyvWf7fdEdPEncB4-impl:B
for bkpcabal08-0.1.0.0...
-[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/A.o ) [Prelude package changed]
-[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/B.o ) [Prelude package changed]
+[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-BOgmYfE3t0l9LsOUH0dl5H-q+sLNLgjkt61DMZK9wGbx81/A.o ) [Prelude package changed]
+[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-BOgmYfE3t0l9LsOUH0dl5H-q+sLNLgjkt61DMZK9wGbx81/B.o ) [Prelude package changed]
Preprocessing library 'r' for bkpcabal08-0.1.0.0...
Building library 'r' for bkpcabal08-0.1.0.0...
=====================================
testsuite/tests/driver/T20604/T20604.stdout
=====================================
@@ -1,11 +1,10 @@
A1
A
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-prim-0.10.0-inplace-ghc9.9.20230815.so" 1403aed32fb9af243c4cc949007c846c
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-bignum-1.3-inplace-ghc9.9.20230815.so" 54293f8faab737bac998f6e1a1248db8
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-internal-0.1.0.0-inplace-ghc9.9.20230815.so" a5c0e962d84d9044d44df4698becddcc
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSbase-4.19.0.0-inplace-ghc9.9.20230815.so" 4a90ed136fe0f89e5d0360daded517bd
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSghc-boot-th-9.9-inplace-ghc9.9.20230815.so" e338655f71b1d37fdfdd2504b7de6e76
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSarray-0.5.6.0-inplace-ghc9.9.20230815.so" 6943478e8adaa043abf7a2b38dd435a2
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSdeepseq-1.5.0.0-inplace-ghc9.9.20230815.so" 9974eb196694990ac6bb3c2591405de0
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHSpretty-1.1.3.6-inplace-ghc9.9.20230815.so" 1eefc21514f5584086f62b70aa554b7d
-addDependentFile "/home/ben/ghc/ghc-compare-2/_build/stage1/lib/../lib/x86_64-linux-ghc-9.9.20230815/libHStemplate-haskell-2.21.0.0-inplace-ghc9.9.20230815.so" f85c86eb94dcce1eacd739b6e991ba2d
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-prim-0.12.0-inplace-ghc9.10.2.20250724.so" 0b7cbf5659e1fd221ea306e2da08c7d3
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-bignum-1.3-inplace-ghc9.10.2.20250724.so" 1c29a409bcfbc31a3cfc2ded7c1d5530
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-internal-9.1002.0-inplace-ghc9.10.2.20250724.so" 9606aee1cbbee934848aa85568563754
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSbase-4.20.1.0-inplace-ghc9.10.2.20250724.so" 5d1ab384becff6d4b20bae121d55fbc8
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSghc-boot-th-9.10.2.20250724-inplace-ghc9.10.2.20250724.so" 930b5206ff48d75ba522e582262695a8
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSdeepseq-1.5.2.0-inplace-ghc9.10.2.20250724.so" db23e7880c9a9fee0d494b48294c3487
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHSpretty-1.1.3.6-inplace-ghc9.10.2.20250724.so" ad484cfb103f02509b1be6abcf2a402f
+addDependentFile "/home/zubin/ghcs/unicode-lex/_build_/stage1/lib/../lib/x86_64-linux-ghc-9.10.2.20250724/libHStemplate-haskell-2.22.0.0-inplace-ghc9.10.2.20250724.so" 50b2cb166e6e5293c24be374ffac2ade
=====================================
testsuite/tests/ghci/scripts/ghci064.stdout
=====================================
@@ -27,12 +27,12 @@ instance [safe] Eq w => Eq (Maybe w)
-- Defined in ‘GHC.Internal.Maybe’
instance GHC.Internal.Generics.Generic [w]
-- Defined in ‘GHC.Internal.Generics’
-instance Monoid [w] -- Defined in ‘GHC.Internal.Base’
-instance Semigroup [w] -- Defined in ‘GHC.Internal.Base’
instance Read w => Read [w] -- Defined in ‘GHC.Internal.Read’
instance Eq w => Eq [w] -- Defined in ‘GHC.Classes’
instance Ord w => Ord [w] -- Defined in ‘GHC.Classes’
instance Show w => Show [w] -- Defined in ‘GHC.Internal.Show’
+instance Monoid [w] -- Defined in ‘GHC.Internal.Base’
+instance Semigroup [w] -- Defined in ‘GHC.Internal.Base’
instance [safe] MyShow w => MyShow [w]
-- Defined at ghci064.hs:8:10
instance GHC.Internal.Generics.Generic [T]
=====================================
testsuite/tests/plugins/plugins10.stdout
=====================================
@@ -7,6 +7,8 @@ interfacePlugin: GHC.Internal.Float
interfacePlugin: GHC.Prim.Ext
interfacePlugin: Language.Haskell.TH.Syntax
typeCheckPlugin (rn)
+interfacePlugin: GHC.Internal.Stack.Types
+interfacePlugin: GHC.Internal.Exception.Context
typeCheckPlugin (tc)
parsePlugin(a)
typeCheckPlugin (rn)
=====================================
testsuite/tests/plugins/static-plugins.stdout
=====================================
@@ -8,6 +8,8 @@ interfacePlugin: GHC.Internal.System.IO
interfacePlugin: GHC.Types
interfacePlugin: GHC.Internal.Show
typeCheckPlugin (rn)
+interfacePlugin: GHC.Internal.Stack.Types
+interfacePlugin: GHC.Internal.Exception.Context
interfacePlugin: GHC.Internal.TopHandler
typeCheckPlugin (tc)
interfacePlugin: GHC.CString
=====================================
testsuite/tests/typecheck/should_run/T25529.hs
=====================================
@@ -0,0 +1,33 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ImplicitParams #-}
+
+module Main where
+
+import GHC.Stack (HasCallStack, CallStack, SrcLoc(srcLocStartLine, srcLocStartCol), callStack, getCallStack)
+
+main :: IO ()
+main =
+ let ?myImplicitParam = ()
+ in run action
+
+type MyConstraints = (HasCallStack, ?myImplicitParam :: ())
+
+action :: MyConstraints => IO ()
+action = run $ pure ()
+
+-- | Print the current call stack and then run an action.
+run ::
+ MyConstraints =>
+ IO a ->
+ IO a
+run action = do
+ let prettyCallStack = unlines $ map prettyCallStackEntry $ getCallStack callStack
+ prettyCallStackEntry (name, loc) =
+ name
+ <> ", called at "
+ <> show (srcLocStartLine loc)
+ <> ":"
+ <> show (srcLocStartCol loc)
+ putStrLn "============================================================"
+ putStrLn prettyCallStack
+ action
=====================================
testsuite/tests/typecheck/should_run/T25529.stdout
=====================================
@@ -0,0 +1,7 @@
+============================================================
+run, called at 11:7
+
+============================================================
+run, called at 16:10
+action, called at 11:11
+
=====================================
testsuite/tests/typecheck/should_run/all.T
=====================================
@@ -170,6 +170,7 @@ test('T22510', normal, compile_and_run, [''])
test('T21973a', [exit_code(1)], compile_and_run, [''])
test('T21973b', normal, compile_and_run, [''])
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, [''])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit f6116257ff838bb0b9def2c49d2f629756527ad2
+Subproject commit 00ac9eec76037ebf4e9b0b84f50675449edc5f51
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecbc5c95372085a4771909342d0daa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecbc5c95372085a4771909342d0daa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0