July 2025 - ghc-commits

[Git][ghc/ghc][master] 11 commits: Bump win32-tarballs to v0.9
by Marge Bot (＠marge-bot) 16 Jul '25

16 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 73082769 by Ben Gamari at 2025-07-15T16:56:38-04:00 Bump win32-tarballs to v0.9 - - - - - 3b63b254 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle null terminated string tables As of `llvm-ar` now emits filename tables terminated with null characters instead of the usual POSIX `/\n` sequence. Fixes #26150. - - - - - 195f6527 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: rename label so name doesn't conflict with param - - - - - 63373b95 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Handle API set symbol versioning conflicts - - - - - 48e9aa3e by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Mark API set symbols as HIDDEN and correct symbol type - - - - - 959e827a by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Implement WEAK EXTERNAL undef redirection by target symbol name - - - - - 65f19293 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle string table entries terminated with / llvm-ar appears to terminate string table entries with `/\n` [1]. This matters in the case of thin archives, since the filename is used. In the past this worked since `llvm-ar` would produce archives with "small" filenames when possible. However, now it appears to always use the string table. [1] https://github.com/llvm/llvm-project/blob/bfb686bb5ba503e9386dc899e1ebbe248… - - - - - 9cbb3ef5 by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Mark T12497 as fixed Thanks to the LLVM toolchain update. Closes #22694. - - - - - 2854407e by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Accept new output of T11223_link_order_a_b_2_fail on Windows The archive member number changed due to the fact that llvm-ar now uses a string table. - - - - - 28439593 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/linker/PEi386: Implement IMAGE_REL_AMD64_SECREL This appears to now be used by libc++ as distributed by msys2. - - - - - 2b053755 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Cleanup merge resolution residue in lookupSymbolInDLL_PEi386 and make safe without dependent - - - - - 6 changed files: - mk/get-win32-tarballs.py - rts/linker/LoadArchive.c - rts/linker/PEi386.c - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 Changes: ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,7 @@ import argparse import sys from sys import stderr -TARBALL_VERSION = '0.8' +TARBALL_VERSION = '0.9' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['x86_64', 'sources'] ===================================== rts/linker/LoadArchive.c ===================================== @@ -223,21 +223,22 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize, size_t* fileNameSize) { - int n; char *fileName = *fileName_; if (isdigit(fileName[1])) { - int i; - for (n = 2; isdigit(fileName[n]); n++) - ; - - fileName[n] = '\0'; - n = atoi(fileName + 1); if (gnuFileIndex == NULL) { errorBelch("loadArchive: GNU-variant filename " "without an index while reading from `%" PATH_FMT "'", path); return false; } + + int n; + for (n = 2; isdigit(fileName[n]); n++) + ; + + char *end; + fileName[n] = '\0'; + n = strtol(fileName + 1, &end, 10); if (n < 0 || n > gnuFileIndexSize) { errorBelch("loadArchive: GNU-variant filename " "offset %d out of range [0..%d] " @@ -245,17 +246,27 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, n, gnuFileIndexSize, path); return false; } - if (n != 0 && gnuFileIndex[n - 1] != '\n') { + + // Check that the previous entry ends with the expected + // end-of-string delimiter. +#if defined(mingw32_HOST_OS) +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n' || STR == '\0') +#else +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n') +#endif + if (n != 0 && !IS_SYMBOL_DELIMITER(gnuFileIndex[n - 1])) { errorBelch("loadArchive: GNU-variant filename offset " "%d invalid (range [0..%d]) while reading " "filename from `%" PATH_FMT "'", n, gnuFileIndexSize, path); return false; } - for (i = n; gnuFileIndex[i] != '\n'; i++) + + int i; + for (i = n; !IS_SYMBOL_DELIMITER(gnuFileIndex[i]); i++) ; - size_t FileNameSize = i - n - 1; + size_t FileNameSize = i - n; if (FileNameSize >= *fileNameSize) { /* Double it to avoid potentially continually increasing it by 1 */ @@ -264,6 +275,13 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, "loadArchive(fileName)"); } memcpy(fileName, gnuFileIndex + n, FileNameSize); + + + /* llvm-ar terminates string table entries with `/\n`. */ + if (fileName[FileNameSize-1] == '/') { + FileNameSize--; + } + fileName[FileNameSize] = '\0'; *thisFileNameSize = FileNameSize; } ===================================== rts/linker/PEi386.c ===================================== @@ -342,6 +342,98 @@ Finally, we enter `ocResolve`, where we resolve relocations and and allocate jump islands (using the m32 allocator for backing storage) as necessary. + Note [Windows API Set] + ~~~~~~~~~~~~~~~~~~~~~~ + Windows has a concept called API Sets [1][2] which is intended to be Windows's + equivalent to glibc's symbolic versioning. It is also used to handle the API + surface difference between different device classes. e.g. the API might be + handled differently between a desktop and tablet. + + This is handled through two mechanisms: + + 1. Direct Forward: These use import libraries to manage to first level + redirection. So what used to be in ucrt.dll is now redirected based on + ucrt.lib. Every API now points to a possible different set of API sets + each following the API set contract: + + * The name must begin either with the string api- or ext-. + * Names that begin with api- represent APIs that exist on all Windows + editions that satisfy the API's version requirements. + * Names that begin with ext- represent APIs that may not exist on all + Windows editions. + * The name must end with the sequence l<n>-<n>-<n>, where n consists of + decimal digits. + * The body of the name can be alphanumeric characters, or dashes (-). + * The name is case insensitive. + + Here are some examples of API set contract names: + + - api-ms-win-core-ums-l1-1-0 + - ext-ms-win-com-ole32-l1-1-5 + - ext-ms-win-ntuser-window-l1-1-0 + - ext-ms-win-ntuser-window-l1-1-1 + + Forward references don't require anything special from the calling + application in that the Windows loader through "LoadLibrary" will + automatically load the right reference for you if given an API set + name including the ".dll" suffix. For example: + + INFO: DLL api-ms-win-eventing-provider-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-apiquery-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\ntdll.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-3.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-registry-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l2-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-handle-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + + Which shows how the loader has redirected some of the references used + by ghci. + + Historically though we've treated shared libs lazily. We would load\ + the shared library, but not resolve the symbol immediately and wait until + the symbol is requested to iterate in order through the shared libraries. + + This assumes that you ever only had one version of a symbol. i.e. we had + an assumption that all exported symbols in different shared libraries + should be the same, because most of the time they come from re-exporting + from a base library. This is a bit of a weak assumption and doesn't hold + with API Sets. + + For that reason the loader now resolves symbols immediately, and because + we now resolve using BIND_NOW we must make sure that a symbol loaded + through an OC has precedent because the BIND_NOW refernce was not asked + for. For that reason we load the symbols for API sets with the + SYM_TYPE_DUP_DISCARD flag set. + + 2. Reverse forwarders: This is when the application has a direct reference + to the old name of an API. e.g. if GHC still used "msvcrt.dll" or + "ucrt.dll" we would have had to deal with this case. In this case the + loader intercepts the call and if it exists the dll is loaded. There is + an extra indirection as you go from foo.dll => api-ms-foo-1.dll => foo_imp.dll + + But if the API doesn't exist on the device it's resolved to a stub in the + API set that if called will result in an error should it be called [3]. + + This means that usages of GetProcAddress and LoadLibrary to check for the + existance of a function aren't safe, because they'll always succeed, but may + result in a pointer to the stub rather than the actual function. + + WHat does this mean for the RTS linker? Nothing. We don't have a fallback + for if the function doesn't exist. The RTS is merely just executing what + it was told to run. It's writers of libraries that have to be careful when + doing dlopen()/LoadLibrary. + + + [1] https://learn.microsoft.com/en-us/windows/win32/apiindex/windows-apisets + [2] https://mingwpy.github.io/ucrt.html#api-set-implementation + [3] https://learn.microsoft.com/en-us/windows/win32/apiindex/detect-api-set-ava… + */ #include "Rts.h" @@ -882,7 +974,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) goto error; } } else { - goto loaded; /* We're done. DLL has been loaded. */ + goto loaded_ok; /* We're done. DLL has been loaded. */ } } } @@ -890,7 +982,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) // We failed to load goto error; -loaded: +loaded_ok: addLoadedDll(&loaded_dll_cache, dll_name, instance); addDLLHandle(buf, instance); if (loaded) { @@ -1055,7 +1147,8 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` // is now a wrapper around `loadNativeObj` which acquires a lock which we // already have here. - const char* result = addDLL_PEi386(dll, NULL); + HINSTANCE instance; + const char* result = addDLL_PEi386(dll, &instance); stgFree(image); @@ -1069,6 +1162,28 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f } stgFree(dll); + + // See Note [Windows API Set] + // We must immediately tie the symbol to the shared library. The easiest + // way is to load the symbol immediately. We already have all the + // information so might as well + SymbolAddr* sym = lookupSymbolInDLL_PEi386 (symbol, instance, dll, NULL); + + // Could be an import descriptor etc, skip if no symbol. + if (!sym) + return true; + + // The symbol must have been found, and we can add it to the RTS symbol table + IF_DEBUG(linker, debugBelch("checkAndLoadImportLibrary: resolved symbol %s to %p\n", symbol, sym)); + // 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. + 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; } @@ -1198,7 +1313,7 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* it generates call *__imp_foo, and __imp_foo here has exactly the same semantics as in __imp_foo = GetProcAddress(..., "foo") */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + if (sym == NULL && dependent && strncmp (lbl, "__imp_", 6) == 0) { sym = GetProcAddress(instance, lbl + 6); if (sym != NULL) { @@ -1214,12 +1329,6 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* } } - sym = GetProcAddress(instance, lbl); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,dll_name);*/ - return sym; - } - return NULL; } @@ -1821,6 +1930,27 @@ ocGetNames_PEi386 ( ObjectCode* oc ) } if(NULL != targetSection) addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); + else + { + // Do the symbol lookup based on name, this follows Microsoft's weak external's + // format 3 specifications. Example header generated: + // api-ms-win-crt-stdio-l1-1-0.dll: file format pe-x86-64 + // + // SYMBOL TABLE: + // [ 0](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @comp.id + // [ 1](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @feat.00 + // [ 2](sec 0)(fl 0x00)(ty 0)(scl 2) (nx 0) 0x0000000000000000 _write + // [ 3](sec 0)(fl 0x00)(ty 0)(scl 105) (nx 1) 0x0000000000000000 write + // AUX lnno 3 size 0x0 tagndx 2 + // + // https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#auxiliary-f… + SymbolName *target_sname = get_sym_name (getSymShortName (info, targetSym), oc); + if (target_sname) + addr = lookupSymbol_PEi386 (target_sname, oc, &type); + + IF_DEBUG(linker, debugBelch("weak external symbol @ %s => %s resolved to %p\n", \ + sname, target_sname, addr)); + } } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { /* This symbol isn't in any section at all, ie, global bss. @@ -2115,6 +2245,13 @@ ocResolve_PEi386 ( ObjectCode* oc ) *(uint64_t *)pP = S + A; break; } + case 11: /* IMAGE_REL_AMD64_SECREL (PE constant 11) */ + { + uint64_t offset = S - (uint64_t) section.start; + CHECK((uint32_t) offset == offset); + *(uint32_t *)pP = offset + A; + break; + } case 2: /* R_X86_64_32 (ELF constant 10) - IMAGE_REL_AMD64_ADDR32 (PE constant 2) */ case 3: /* IMAGE_REL_AMD64_ADDR32NB (PE constant 3) */ case 17: /* R_X86_64_32S ELF constant, no PE mapping. See note [ELF constant in PE file] */ ===================================== testsuite/tests/rts/all.T ===================================== @@ -426,9 +426,7 @@ test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) test('numa001', [ extra_run_opts('8'), unless(unregisterised(), extra_ways(['debug_numa'])), req_ghc_with_threaded_rts ] , compile_and_run, ['']) -test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694) - ], - makefile_test, ['T12497']) +test('T12497', unless(opsys('mingw32'), skip), makefile_test, ['T12497']) test('T13617', [ unless(opsys('mingw32'), skip)], makefile_test, ['T13617']) ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3cd4ec8b919fd45236de3de28ecc5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3cd4ec8b919fd45236de3de28ecc5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/9.10.3-backports] 3 commits: Error message with EmptyCase and RequiredTypeArguments (#25004)
by Zubin (＠wz1000) 16 Jul '25

16 Jul '25

Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC Commits: c6f8e88b by Vladislav Zavialov at 2025-07-16T17:59:21+05:30 Error message with EmptyCase and RequiredTypeArguments (#25004) Fix a panic triggered by a combination of \case{} and forall t -> ghci> let f :: forall (xs :: Type) -> (); f = \case {} panic! (the 'impossible' happened) GHC version 9.10.1: Util: only The new error message looks like this: ghci> let f :: forall (xs :: Type) -> (); f = \case {} <interactive>:5:41: error: [GHC-48010] • Empty list of alternatives in \case expression checked against a forall-type: forall xs -> ... This is achieved as follows: * A new data type, BadEmptyCaseReason, is now used to describe why an empty case has been rejected. Used in TcRnEmptyCase. * HsMatchContextRn is passed to tcMatches, so that the type checker can attach the syntactic context to the error message. * tcMatches now rejects type arguments if the list of alternatives is empty. This is what fixes the bug. (cherry picked from commit cce869ea2439bb16c284ce7ed71a173d54a8c9ad) - - - - - 7b1dbd0c by Vladislav Zavialov at 2025-07-16T18:04:08+05:30 Fix EmptyCase panic in tcMatches (#25960) Due to faulty reasoning in Note [Pattern types for EmptyCase], tcMatches was too keen to panic. * Old (incorrect) assumption: pat_tys is a singleton list. This does not hold when \case{} is checked against a function type preceded by invisible forall. See the new T25960 test case. * New (hopefully correct) assumption: vis_pat_tys is a singleton list. This should follow from: checkArgCounts :: MatchGroup GhcRn ... -> TcM VisArity checkArgCounts (MG { mg_alts = L _ [] }) = return 1 ... (cherry picked from commit b34890c7d4803041caff060391eec298e2b0a098) - - - - - 16bde049 by Andreas Klebinger at 2025-07-16T18:04:08+05:30 Add since tag and more docs for do-clever-arg-eta-expansion Fixes #26113 (cherry picked from commit 699deef58bf89ef2f111b35f72d303a3624d219d) - - - - - 14 changed files: - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - docs/users_guide/using-optimisation.rst - + testsuite/tests/typecheck/should_compile/T25960.hs - testsuite/tests/typecheck/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T25004.hs - + testsuite/tests/typecheck/should_fail/T25004.stderr - + testsuite/tests/typecheck/should_fail/T25004k.hs - + testsuite/tests/typecheck/should_fail/T25004k.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -1303,14 +1303,38 @@ rnMatchGroup :: (Outputable (body GhcPs), AnnoBody body) => HsMatchContextRn -> RnM (MatchGroup GhcRn (LocatedA (body GhcRn)), FreeVars) rnMatchGroup ctxt rnBody (MG { mg_alts = L lm ms, mg_ext = origin }) -- see Note [Empty MatchGroups] - = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (TcRnEmptyCase ctxt)) + = do { when (null ms) $ checkEmptyCase ctxt ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms ; return (mkMatchGroup origin (L lm new_ms), ms_fvs) } + +-- Check the validity of a MatchGroup with an empty list of alternatives. +-- +-- 1. Normal `case x of {}` passes this check as long as EmptyCase is enabled. +-- Ditto lambda-case `\case {}`. +-- +-- 2. Multi-case with no alternatives `\cases {}` is never valid. +-- +-- 3. Other MatchGroup contexts (FunRhs, LamAlt LamSingle, etc) are not +-- considered here because there is no syntax to construct them with +-- no alternatives. +-- +-- Test case: rename/should_fail/RnEmptyCaseFail +-- +-- Validation continues in the type checker, namely in tcMatches. +-- See Note [Pattern types for EmptyCase] in GHC.Tc.Gen.Match +checkEmptyCase :: HsMatchContextRn -> RnM () +checkEmptyCase ctxt + | disallowed_ctxt = + addErr (TcRnEmptyCase ctxt EmptyCaseDisallowedCtxt) + | otherwise = + unlessXOptM LangExt.EmptyCase $ + addErr (TcRnEmptyCase ctxt EmptyCaseWithoutFlag) where - mustn't_be_empty = case ctxt of - LamAlt LamCases -> return True - ArrowMatchCtxt (ArrowLamAlt LamCases) -> return True - _ -> not <$> xoptM LangExt.EmptyCase + disallowed_ctxt = + case ctxt of + LamAlt LamCases -> True + ArrowMatchCtxt (ArrowLamAlt LamCases) -> True + _ -> False rnMatch :: AnnoBody body => HsMatchContextRn ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) import GHC.Core.InstEnv import GHC.Core.TyCo.Rep (Type(..)) import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon, - pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType) + pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll) import GHC.Core.PatSyn ( patSynName, pprPatSynType ) import GHC.Core.Predicate import GHC.Core.Type @@ -1299,24 +1299,27 @@ instance Diagnostic TcRnMessage where text "Orphan COMPLETE pragmas not supported" $$ text "A COMPLETE pragma must mention at least one data constructor" $$ text "or pattern synonym defined in the same module." - TcRnEmptyCase ctxt -> mkSimpleDecorated message - where - pp_ctxt = case ctxt of - CaseAlt -> text "case expression" - LamAlt LamCase -> text "\\case expression" - ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction" - ArrowMatchCtxt (ArrowLamAlt LamCase) -> text "\\case command" - ArrowMatchCtxt ArrowCaseAlt -> text "case command" - _ -> text "(unexpected)" - <+> pprMatchContextNoun ctxt - - message = case ctxt of - LamAlt LamCases -> lcases_msg <+> text "expression" - ArrowMatchCtxt (ArrowLamAlt LamCases) -> lcases_msg <+> text "command" - _ -> text "Empty list of alternatives in" <+> pp_ctxt - - lcases_msg = - text "Empty list of alternatives is not allowed in \\cases" + TcRnEmptyCase ctxt reason -> mkSimpleDecorated $ + case reason of + EmptyCaseWithoutFlag -> + text "Empty list of alternatives in" <+> pp_ctxt + EmptyCaseDisallowedCtxt -> + text "Empty list of alternatives is not allowed in" <+> pp_ctxt + EmptyCaseForall tvb -> + vcat [ text "Empty list of alternatives in" <+> pp_ctxt + , hang (text "checked against a forall-type:") + 2 (pprForAll [tvb] <+> text "...") + ] + where + pp_ctxt = case ctxt of + CaseAlt -> text "case expression" + LamAlt LamCase -> text "\\case expression" + LamAlt LamCases -> text "\\cases expression" + ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction" + ArrowMatchCtxt (ArrowLamAlt LamCase) -> text "\\case command" + ArrowMatchCtxt (ArrowLamAlt LamCases) -> text "\\cases command" + ArrowMatchCtxt ArrowCaseAlt -> text "case command" + ctxt -> text "(unexpected)" <+> pprMatchContextNoun ctxt TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $ text "accepting non-standard pattern guards" $$ nest 4 (interpp'SP guards) @@ -2988,10 +2991,11 @@ instance Diagnostic TcRnMessage where -> noHints TcRnOrphanCompletePragma{} -> noHints - TcRnEmptyCase ctxt -> case ctxt of - LamAlt LamCases -> noHints -- cases syntax doesn't support empty case. - ArrowMatchCtxt (ArrowLamAlt LamCases) -> noHints - _ -> [suggestExtension LangExt.EmptyCase] + TcRnEmptyCase _ reason -> + case reason of + EmptyCaseWithoutFlag{} -> [suggestExtension LangExt.EmptyCase] + EmptyCaseDisallowedCtxt{} -> noHints + EmptyCaseForall{} -> noHints TcRnNonStdGuards{} -> [suggestExtension LangExt.PatternGuards] TcRnDuplicateSigDecl{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -103,6 +103,7 @@ module GHC.Tc.Errors.Types ( , DisabledClassExtension(..) , TyFamsDisabledReason(..) , TypeApplication(..) + , BadEmptyCaseReason(..) , HsTypeOrSigType(..) , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons @@ -204,7 +205,8 @@ import GHC.Core.InstEnv (LookupInstanceErrReason, ClsInst, DFunId) import GHC.Core.PatSyn (PatSyn) import GHC.Core.Predicate (EqRel, predTypeEqRel) import GHC.Core.TyCon (TyCon, Role, FamTyConFlav, AlgTyConRhs) -import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag) +import GHC.Core.Type (Kind, Type, ThetaType, PredType, ErrorMsgType, ForAllTyFlag, ForAllTyBinder) + import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState) import GHC.Utils.Misc (filterOut) @@ -3005,13 +3007,27 @@ data TcRnMessage where a case expression with an empty list of alternatives without enabling the EmptyCase extension. - Example(s): + Example for EmptyCaseWithoutFlag: + + {-# LANGUAGE NoEmptyCase #-} + f :: Void -> a + f = \case {} -- extension not enabled + + Example for EmptyCaseDisallowedCtxt: - case () of + f = \cases {} -- multi-case requires n>0 alternatives + + Example for EmptyCaseForall: + + f :: forall (xs :: Type) -> () + f = \case {} -- can't match on a type argument Test cases: rename/should_fail/RnEmptyCaseFail + typecheck/should_fail/T25004 -} - TcRnEmptyCase :: HsMatchContextRn -> TcRnMessage + TcRnEmptyCase :: !HsMatchContextRn + -> !BadEmptyCaseReason + -> TcRnMessage {-| TcRnNonStdGuards is a warning thrown when a user uses non-standard guards (e.g. patterns in guards) without @@ -6083,6 +6099,12 @@ data TypeApplication | TypeApplicationInPattern !(HsConPatTyArg GhcPs) deriving Generic +-- | Why was the empty case rejected? +data BadEmptyCaseReason + = EmptyCaseWithoutFlag + | EmptyCaseDisallowedCtxt + | EmptyCaseForall ForAllTyBinder + -- | Either `HsType p` or `HsSigType p`. -- -- Used for reporting errors in `TcRnIllegalKind`. ===================================== compiler/GHC/Tc/Gen/Arrow.hs ===================================== @@ -319,8 +319,9 @@ tcCmdMatches :: CmdEnv -> CmdType -> TcM (HsWrapper, MatchGroup GhcTc (LHsCmd GhcTc)) tcCmdMatches env scrut_ty matches (stk, res_ty) - = tcCaseMatches tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty) + = tcCaseMatches ctxt tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty) where + ctxt = ArrowMatchCtxt ArrowCaseAlt tc_body body res_ty' = do { res_ty' <- expTypeToType res_ty' ; tcCmd env body (stk, res_ty') } ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -457,7 +457,7 @@ tcExpr (HsCase ctxt scrut matches) res_ty ; (scrut', scrut_ty) <- tcScalingUsage mult $ tcInferRho scrut ; hasFixedRuntimeRep_syntactic FRRCase scrut_ty - ; (mult_co_wrap, matches') <- tcCaseMatches tcBody (Scaled mult scrut_ty) matches res_ty + ; (mult_co_wrap, matches') <- tcCaseMatches ctxt tcBody (Scaled mult scrut_ty) matches res_ty ; return (HsCase ctxt (mkLHsWrap mult_co_wrap scrut') matches') } tcExpr (HsIf x pred b1 b2) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -122,11 +122,12 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty do { traceTc "tcFunBindMatches 2" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys , ppr pat_tys $$ ppr rhs_ty ]) - ; tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches } + ; tcMatches mctxt tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches } ; return (wrap_fun <.> wrap_mult, r) } where - herald = ExpectedFunTyMatches (NameThing fun_name) matches + herald = ExpectedFunTyMatches (NameThing fun_name) matches + mctxt = mkPrefixFunRhs (noLocA fun_name) funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool funBindPrecondition (MG { mg_alts = L _ alts }) @@ -146,10 +147,11 @@ tcLambdaMatches e lam_variant matches invis_pat_tys res_ty ; (wrapper, (mult_co_wrap, r)) <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ pat_tys rhs_ty -> - tcMatches tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches + tcMatches ctxt tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches ; return (wrapper <.> mult_co_wrap, r) } where + ctxt = LamAlt lam_variant herald = ExpectedFunTyLam lam_variant e -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify @@ -167,7 +169,8 @@ parser guarantees that each equation has exactly one argument. -} tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc)) - => TcMatchAltChecker body -- ^ Typecheck the alternative RHSS + => HsMatchContextRn + -> TcMatchAltChecker body -- ^ Typecheck the alternative RHSS -> Scaled TcSigmaTypeFRR -- ^ Type of scrutinee -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives -> ExpRhoType -- ^ Type of the whole case expression @@ -175,8 +178,8 @@ tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc)) -- Translated alternatives -- wrapper goes from MatchGroup's ty to expected ty -tcCaseMatches tc_body (Scaled scrut_mult scrut_ty) matches res_ty - = tcMatches tc_body [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches +tcCaseMatches ctxt tc_body (Scaled scrut_mult scrut_ty) matches res_ty + = tcMatches ctxt tc_body [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@. tcGRHSsPat :: Mult -> GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType @@ -223,23 +226,30 @@ type AnnoBody body -- | Type-check a MatchGroup. tcMatches :: (AnnoBody body, Outputable (body GhcTc)) - => TcMatchAltChecker body + => HsMatchContextRn + -> TcMatchAltChecker body -> [ExpPatType] -- ^ Expected pattern types. -> ExpRhoType -- ^ Expected result-type of the Match. -> MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc))) -tcMatches tc_body pat_tys rhs_ty (MG { mg_alts = L l matches - , mg_ext = origin }) +tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches + , mg_ext = origin }) | null matches -- Deal with case e of {} -- Since there are no branches, no one else will fill in rhs_ty -- when in inference mode, so we must do it ourselves, -- here, using expTypeToType = do { tcEmitBindingUsage bottomUE - ; pat_tys <- mapM scaledExpTypeToType (filter_out_forall_pat_tys pat_tys) + -- See Note [Pattern types for EmptyCase] + ; let vis_pat_tys = filter isVisibleExpPatType pat_tys + ; pat_ty <- case vis_pat_tys of + [ExpFunPatTy t] -> scaledExpTypeToType t + [ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb) + [] -> panic "tcMatches: no arguments in EmptyCase" + _t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase" ; rhs_ty <- expTypeToType rhs_ty ; return (idHsWrapper, MG { mg_alts = L l [] - , mg_ext = MatchGroupTc pat_tys rhs_ty origin + , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin }) } | otherwise @@ -262,6 +272,43 @@ tcMatches tc_body pat_tys rhs_ty (MG { mg_alts = L l matches match_fun_pat_ty (ExpFunPatTy t) = Just t match_fun_pat_ty ExpForAllPatTy{} = Nothing +{- Note [Pattern types for EmptyCase] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In tcMatches, we might encounter an empty list of matches if the user wrote +`case x of {}` or `\case {}`. + +* First of all, both `case x of {}` and `\case {}` match on exactly one visible + argument, which follows from + + checkArgCounts :: MatchGroup GhcRn ... -> TcM VisArity + checkArgCounts (MG { mg_alts = L _ [] }) + = return 1 + ... + + So we expect vis_pat_tys to be a singleton list [pat_ty] and panic otherwise. + + Multi-case `\cases {}` can't violate this assumption in `tcMatches` because it + must have been rejected earlier in `rnMatchGroup`. + + Other MatchGroup contexts (function equations `f x = ...`, lambdas `\a b -> ...`, + etc) are not considered here because there is no syntax to construct them with + an empty list of alternatives. + +* With lambda-case, we run the risk of trying to match on a type argument: + + f :: forall (xs :: Type) -> () + f = \case {} + + This is not valid and it used to trigger a panic in pmcMatches (#25004). + We reject it by inspecting the expected pattern type: + + ; pat_ty <- case vis_pat_tys of + [ExpFunPatTy t] -> ... -- value argument, ok + [ExpForAllPatTy tvb] -> ... -- type argument, error! + + Test case: typecheck/should_fail/T25004 +-} + ------------- tcMatch :: (AnnoBody body) => TcMatchAltChecker body ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -517,16 +517,24 @@ as such you shouldn't need to set any of them explicitly. A flag Eta-expand let-bindings to increase their arity. .. ghc-flag:: -fdo-clever-arg-eta-expansion - :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`. + :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-do-clever-arg-eta-expansion :category: :default: off + :since: 9.10.1 Eta-expand arguments to increase their arity to avoid allocating unnecessary thunks for them. + For example in code like `foo = f (g x)` this flag will determine which analysis + is used to decide the arity of `g x`, with the goal of avoiding a thunk for `g x` + in cases where `g` is a function with an arity higher than one. + + Enabling the flag enables a more sophisticated analysis, resulting in better + runtime but longer compile time. + .. ghc-flag:: -feager-blackholing :shortdesc: Turn on :ref:`eager blackholing <parallel-compile-options>` :type: dynamic ===================================== testsuite/tests/typecheck/should_compile/T25960.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE LambdaCase #-} + +module T25960 where + +import Data.Void (Void) + +f :: (forall a. Void -> a) -> (forall a. Void -> a) +f g = g + +absurd :: Void -> a +absurd = f (\case) + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -926,3 +926,4 @@ test('T24566', [], makefile_test, []) test('T23739a', normal, compile, ['']) test('T24810', normal, compile, ['']) test('T25597', normal, compile, ['']) +test('T25960', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T25004.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE RequiredTypeArguments, EmptyCase, LambdaCase #-} +{-# OPTIONS -Wincomplete-patterns #-} + +module T25004 where + +import Data.Kind + +f :: forall (xs :: Type) -> () +f = \case {} ===================================== testsuite/tests/typecheck/should_fail/T25004.stderr ===================================== @@ -0,0 +1,6 @@ +T25004.hs:9:5: error: [GHC-48010] + • Empty list of alternatives in \case expression + checked against a forall-type: forall xs -> ... + • In the expression: \case + In an equation for ‘f’: f = \case + ===================================== testsuite/tests/typecheck/should_fail/T25004k.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE RequiredTypeArguments, EmptyCase, LambdaCase #-} +{-# OPTIONS -Wincomplete-patterns #-} + +module T25004k where + +import Data.Kind + +f :: ((forall k. forall (xs :: k) -> ()) -> r) -> r +f cont = cont (\case {}) ===================================== testsuite/tests/typecheck/should_fail/T25004k.stderr ===================================== @@ -0,0 +1,7 @@ +T25004k.hs:9:16: error: [GHC-48010] + • Empty list of alternatives in \case expression + checked against a forall-type: forall (xs :: k) -> ... + • In the first argument of ‘cont’, namely ‘(\case)’ + In the expression: cont (\case) + In an equation for ‘f’: f cont = cont (\case) + ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -727,4 +727,6 @@ test('T24470a', normal, compile_fail, ['']) test('T24553', normal, compile_fail, ['']) test('T23739b', normal, compile_fail, ['']) -test('T25325', normal, compile_fail, ['']) \ No newline at end of file +test('T25325', normal, compile_fail, ['']) +test('T25004', normal, compile_fail, ['']) +test('T25004k', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/777810c8f32542d8486b5a53248225… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/777810c8f32542d8486b5a53248225… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ann-frame] 2 commits: WIP: Introduce stack frame annotation helpers and extend ghc-heap stack decoder
by Hannes Siebenhandl (＠fendor) 16 Jul '25

16 Jul '25

Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC Commits: b8bd47d7 by fendor at 2025-07-16T11:35:47+02:00 WIP: Introduce stack frame annotation helpers and extend ghc-heap stack decoder - - - - - dda9f198 by fendor at 2025-07-16T11:35:47+02:00 WIP: base: extend Backtraces to allow configuration of stack decoders - - - - - 8 changed files: - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs - libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs Changes: ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -3,65 +3,106 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE ImplicitParams #-} -module GHC.Stack.Annotation.Experimental where +module GHC.Stack.Annotation.Experimental ( + IsStackAnnotation(..), + SomeStackAnnotation(..), + -- * Source Location annotations + SrcLocAnnotation, + UnknownSrcLocAnnotation, + -- * Stack annotations + annotateStack, + annotateShow, + annotateStackM, + annotateStringM, + annotateStackShowM, + annotateCallStackM, + ) where import Data.Typeable import GHC.Exts import GHC.IO -import GHC.Internal.Stack.Types +import GHC.Internal.Stack -data StackAnnotation where - StackAnnotation :: forall a. (Typeable a, Show a) => a -> StackAnnotation +-- ---------------------------------------------------------------------------- +-- IsStackAnnotation +-- ---------------------------------------------------------------------------- class IsStackAnnotation a where - display :: a -> String + displayStackAnnotation :: a -> String -instance IsStackAnnotation StackAnnotation where - display (StackAnnotation a) = show a +-- ---------------------------------------------------------------------------- +-- Annotations +-- ---------------------------------------------------------------------------- -newtype SrcLocAnno = MkSrcLocAnno SrcLoc +{- | +The @SomeStackAnnotation@ type is the root of the stack annotation type hierarchy. +When the call stack is annotated with a value of type @a@, behind the scenes it is +encapsulated in a @SomeStackAnnotation@. +-} +data SomeStackAnnotation where + SomeStackAnnotation :: forall a. (Typeable a, IsStackAnnotation a) => a -> SomeStackAnnotation -data UnknownSrcLocAnno = UnknownSrcLocAnno +instance IsStackAnnotation SomeStackAnnotation where + displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a + +data StringAnnotation where + StringAnnotation :: String -> StringAnnotation + +instance IsStackAnnotation StringAnnotation where + displayStackAnnotation (StringAnnotation str) = str + +-- ---------------------------------------------------------------------------- +-- Source location annotations +-- ---------------------------------------------------------------------------- + +newtype SrcLocAnnotation = SrcLocAnnotation SrcLoc + +data UnknownSrcLocAnnotation = UnknownSrcLocAnnotation deriving Show -instance Show SrcLocAnno where - show (MkSrcLocAnno l) = - concat - [ srcLocPackage l - , ":" - , srcLocModule l - , " " - , srcLocFile l - , ":" - , show $ srcLocStartLine l - , "-" - , show $ srcLocStartCol l - , ":" - , show $ srcLocEndLine l - , "-" - , show $ srcLocEndCol l - ] - -instance IsStackAnnotation SrcLocAnno where - display = show - -instance IsStackAnnotation UnknownSrcLocAnno where - display UnknownSrcLocAnno = "UnknownSrcLocAnno" +instance Show SrcLocAnnotation where + show (SrcLocAnnotation l) = prettySrcLoc l + +instance IsStackAnnotation SrcLocAnnotation where + displayStackAnnotation = show + +instance IsStackAnnotation UnknownSrcLocAnnotation where + displayStackAnnotation UnknownSrcLocAnnotation = "<no location info>" + +-- ---------------------------------------------------------------------------- +-- Annotate the CallStack! +-- ---------------------------------------------------------------------------- {-# NOINLINE annotateStack #-} -annotateStack :: forall a b. (Typeable a, Show a) => a -> b -> b +-- TODO @fendor: it seems the pure interface doesnt work, +-- investigate more and then decide what to do +annotateStack :: forall a b. (Typeable a, IsStackAnnotation a) => a -> b -> b annotateStack ann b = unsafePerformIO $ annotateStackM ann (pure b) -annotateStackM :: forall a b . (Typeable a, Show a) => a -> IO b -> IO b +-- TODO @fendor: it seems the pure interface doesnt work, +-- investigate more and then decide what to do +annotateShow :: forall a b . (Typeable a, Show a) => a -> b -> b +annotateShow ann = + annotateStack (StringAnnotation $ show ann) + +annotateStackM :: forall a b . (Typeable a, IsStackAnnotation a) => a -> IO b -> IO b annotateStackM ann (IO act) = - IO $ \s -> annotateStack# (StackAnnotation ann) act s + IO $ \s -> annotateStack# (SomeStackAnnotation ann) act s + +annotateStringM :: forall b . String -> IO b -> IO b +annotateStringM ann = + annotateStackM (StringAnnotation ann) + +annotateStackShowM :: forall a b . (Typeable a, Show a) => a -> IO b -> IO b +annotateStackShowM ann = + annotateStringM (show ann) annotateCallStackM :: HasCallStack => IO a -> IO a annotateCallStackM act = let cs = getCallStack ?callStack in case cs of - [] -> annotateStackM UnknownSrcLocAnno act - [(_, srcLoc)] -> annotateStackM (MkSrcLocAnno srcLoc) act - (_:(_, srcLoc):_) -> annotateStackM (MkSrcLocAnno srcLoc) act + [] -> annotateStackM UnknownSrcLocAnnotation act + [(_, srcLoc)] -> annotateStackM (SrcLocAnnotation srcLoc) act + (_:(_, srcLoc):_) -> annotateStackM (SrcLocAnnotation srcLoc) act ===================================== libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc ===================================== @@ -24,7 +24,7 @@ import Foreign -- | Read an InfoTable from the heap into a haskell type. -- WARNING: This code assumes it is passed a pointer to a "standard" info --- table. If tables_next_to_code is enabled, it will look 1 byte before the +-- table. If tables_next_to_code is disabled, it will look 1 word before the -- start for the entry field. peekItbl :: Ptr StgInfoTable -> IO StgInfoTable peekItbl a0 = do ===================================== libraries/ghc-heap/GHC/Exts/Stack/Decode.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Exts.Stack.Decode ( decodeStack, + decodeStackWithIpe, ) where @@ -36,6 +37,7 @@ import GHC.Exts.Heap.Closures import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS) import GHC.Exts.Heap.InfoTable import GHC.Exts.Stack.Constants +import qualified GHC.Internal.InfoProv.Types as IPE import GHC.Stack.CloneStack import GHC.Word import Prelude @@ -150,14 +152,17 @@ foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter -foreign import prim "getInfoTableAddrzh" getInfoTableAddr# :: StackSnapshot# -> Word# -> Addr# +foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# -> Word# -> (# Addr#, Addr# #) foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr# -getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO StgInfoTable +-- | Get the 'StgInfoTable' of the stack frame. +-- Additionally, provides 'IPE.InfoProv' for the 'StgInfoTable' if there is any. +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe IPE.InfoProv) getInfoTableOnStack stackSnapshot# index = - let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index)) - in peekItbl infoTablePtr + let !(# itbl_struct#, itbl_ptr# #) = getInfoTableAddrs# stackSnapshot# (wordOffsetToWord# index) + in + (,) <$> peekItbl (Ptr itbl_struct#) <*> IPE.lookupIPE (Ptr itbl_ptr#) getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable getInfoTableForStack stackSnapshot# = @@ -276,18 +281,49 @@ decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset = (bitmapWordPointerness size bitmap) unpackStackFrame :: StackFrameLocation -> IO StackFrame -unpackStackFrame (StackSnapshot stackSnapshot#, index) = do - info <- getInfoTableOnStack stackSnapshot# index +unpackStackFrame stackFrameLoc = do + unpackStackFrameTo stackFrameLoc + (\ info nextChunk -> do + stackClosure <- decodeStack nextChunk + pure $ + UnderflowFrame + { info_tbl = info, + nextChunk = stackClosure + } + ) + (\ frame _ -> pure frame) + +unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe IPE.InfoProv)] +unpackStackFrameWithIpe stackFrameLoc = do + unpackStackFrameTo stackFrameLoc + (\ _ nextChunk -> do + decodeStackWithIpe nextChunk + ) + (\ frame mIpe -> pure [(frame, mIpe)]) + +unpackStackFrameTo :: + StackFrameLocation -> + (StgInfoTable -> StackSnapshot -> IO a) -> + (StackFrame -> Maybe IPE.InfoProv -> IO a) -> + IO a +unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame finaliseStackFrame = do + (info, m_info_prov) <- getInfoTableOnStack stackSnapshot# index unpackStackFrame' info + unpackUnderflowFrame + (`finaliseStackFrame` m_info_prov) where - unpackStackFrame' :: StgInfoTable -> IO StackFrame - unpackStackFrame' info = + unpackStackFrame' :: + StgInfoTable -> + (StgInfoTable -> StackSnapshot -> IO a) -> + (StackFrame -> IO a) -> + IO a + unpackStackFrame' info unpackUnderflowFrame mkStackFrameResult = case tipe info of RET_BCO -> do let bco' = getClosureBox stackSnapshot# (index + offsetStgClosurePayload) -- The arguments begin directly after the payload's one element bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# stackSnapshot# index (offsetStgClosurePayload + 1) - pure + mkStackFrameResult RetBCO { info_tbl = info, bco = bco', @@ -296,14 +332,14 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do RET_SMALL -> let payload' = decodeSmallBitmap getSmallBitmap# stackSnapshot# index offsetStgClosurePayload in - pure $ + mkStackFrameResult $ RetSmall { info_tbl = info, stack_payload = payload' } RET_BIG -> do payload' <- decodeLargeBitmap getLargeBitmap# stackSnapshot# index offsetStgClosurePayload - pure $ + mkStackFrameResult $ RetBig { info_tbl = info, stack_payload = payload' @@ -315,7 +351,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do if isArgGenBigRetFunType stackSnapshot# index == True then decodeLargeBitmap getRetFunLargeBitmap# stackSnapshot# index offsetStgRetFunFramePayload else pure $ decodeSmallBitmap getRetFunSmallBitmap# stackSnapshot# index offsetStgRetFunFramePayload - pure $ + mkStackFrameResult $ RetFun { info_tbl = info, retFunSize = retFunSize', @@ -325,31 +361,26 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do UPDATE_FRAME -> let updatee' = getClosureBox stackSnapshot# (index + offsetStgUpdateFrameUpdatee) in - pure $ + mkStackFrameResult $ UpdateFrame { info_tbl = info, updatee = updatee' } CATCH_FRAME -> do let handler' = getClosureBox stackSnapshot# (index + offsetStgCatchFrameHandler) - pure $ + mkStackFrameResult $ CatchFrame { info_tbl = info, handler = handler' } UNDERFLOW_FRAME -> do let nextChunk' = getUnderflowFrameNextChunk stackSnapshot# index - stackClosure <- decodeStack nextChunk' - pure $ - UnderflowFrame - { info_tbl = info, - nextChunk = stackClosure - } - STOP_FRAME -> pure $ StopFrame {info_tbl = info} + unpackUnderflowFrame info nextChunk' + STOP_FRAME -> mkStackFrameResult $ StopFrame {info_tbl = info} ATOMICALLY_FRAME -> do let atomicallyFrameCode' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameCode) result' = getClosureBox stackSnapshot# (index + offsetStgAtomicallyFrameResult) - pure $ + mkStackFrameResult $ AtomicallyFrame { info_tbl = info, atomicallyFrameCode = atomicallyFrameCode', @@ -360,7 +391,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do first_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameRunningFirstCode) alt_code' = getClosureBox stackSnapshot# (index + offsetStgCatchRetryFrameAltCode) in - pure $ + mkStackFrameResult $ CatchRetryFrame { info_tbl = info, running_alt_code = running_alt_code', @@ -371,7 +402,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do let catchFrameCode' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameCode) handler' = getClosureBox stackSnapshot# (index + offsetStgCatchSTMFrameHandler) in - pure $ + mkStackFrameResult $ CatchStmFrame { info_tbl = info, catchFrameCode = catchFrameCode', @@ -380,7 +411,7 @@ unpackStackFrame (StackSnapshot stackSnapshot#, index) = do ANN_FRAME -> let annotation = getClosureBox stackSnapshot# (index + offsetStgAnnFrameAnn) in - pure $ + mkStackFrameResult $ AnnFrame { info_tbl = info, annotation = annotation @@ -410,19 +441,27 @@ type StackFrameLocation = (StackSnapshot, WordOffset) -- -- See /Note [Decoding the stack]/. decodeStack :: StackSnapshot -> IO StgStackClosure -decodeStack (StackSnapshot stack#) = do +decodeStack snapshot@(StackSnapshot stack#) = do + (stackInfo, ssc_stack) <- decodeStackWithFrameUnpack unpackStackFrame snapshot + pure + GenStgStackClosure + { ssc_info = stackInfo, + ssc_stack_size = getStackFields stack#, + ssc_stack = ssc_stack + } + +decodeStackWithIpe :: StackSnapshot -> IO [(StackFrame, Maybe IPE.InfoProv)] +decodeStackWithIpe snapshot = + concat . snd <$> decodeStackWithFrameUnpack unpackStackFrameWithIpe snapshot + +decodeStackWithFrameUnpack :: (StackFrameLocation -> IO a) -> StackSnapshot -> IO (StgInfoTable, [a]) +decodeStackWithFrameUnpack unpackFrame (StackSnapshot stack#) = do info <- getInfoTableForStack stack# case tipe info of STACK -> do - let stack_size' = getStackFields stack# - sfls = stackFrameLocations stack# - stack' <- mapM unpackStackFrame sfls - pure $ - GenStgStackClosure - { ssc_info = info, - ssc_stack_size = stack_size', - ssc_stack = stack' - } + let sfls = stackFrameLocations stack# + stack' <- mapM unpackFrame sfls + pure (info, stack') _ -> error $ "Expected STACK closure, got " ++ show info where stackFrameLocations :: StackSnapshot# -> [StackFrameLocation] ===================================== libraries/ghc-heap/cbits/Stack.cmm ===================================== @@ -146,14 +146,14 @@ isArgGenBigRetFunTypezh(P_ stack, W_ offsetWords) { return (type); } -// (StgInfoTable*) getInfoTableAddrzh(StgStack* stack, StgWord offsetWords) -getInfoTableAddrzh(P_ stack, W_ offsetWords) { - P_ p, info; +// (StgInfoTable*, StgInfoTable*) getInfoTableAddrszh(StgStack* stack, StgWord offsetWords) +getInfoTableAddrszh(P_ stack, W_ offsetWords) { + P_ p, info_struct, info_ptr; p = StgStack_sp(stack) + WDS(offsetWords); ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info = %GET_STD_INFO(UNTAG(p)); - - return (info); + info_struct = %GET_STD_INFO(UNTAG(p)); + info_ptr = %INFO_PTR(UNTAG(p)); + return (info_struct, info_ptr); } // (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack) ===================================== libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs ===================================== @@ -7,7 +7,7 @@ import System.IO.Unsafe import Unsafe.Coerce hello :: Int -> Int -> Int -hello x y = annotateStack (x,y) $ +hello x y = annotateShow (x,y) $ decodeAndPrintAnnotationFrames $! x + y + 42 {-# OPAQUE hello #-} @@ -17,9 +17,9 @@ decodeAndPrintAnnotationFrames :: a -> a decodeAndPrintAnnotationFrames a = unsafePerformIO $ do stack <- GHC.Stack.CloneStack.cloneMyStack decoded <- GHC.Exts.Stack.Decode.decodeStack stack - print [ show a + print [ displayStackAnnotation a | Closures.AnnFrame _ (Box ann) <- Closures.ssc_stack decoded - , StackAnnotation a <- pure $ unsafeCoerce ann + , SomeStackAnnotation a <- pure $ unsafeCoerce ann ] pure a @@ -30,13 +30,13 @@ main = do {-# INLINE tailCallEx #-} tailCallEx :: Int -> Int -> Int -tailCallEx a b = annotateStack "tailCallEx" $ foo a b +tailCallEx a b = annotateShow "tailCallEx" $ foo a b {-# INLINE foo #-} foo :: Int -> Int -> Int -foo a b = annotateStack "foo" $ bar $ a * b +foo a b = annotateShow "foo" $ bar $ a * b -bar c = annotateStack "bar" $ +bar c = annotateShow "bar" $ decodeAndPrintAnnotationFrames $ c + c ===================================== libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs ===================================== @@ -12,17 +12,7 @@ import qualified GHC.Internal.Stack.CloneStack as CloneStack import System.IO.Unsafe import Unsafe.Coerce - -{-# NOINLINE decodeAnnotationFrames #-} -decodeAnnotationFrames :: IO [String] -decodeAnnotationFrames = do - stack <- CloneStack.cloneMyStack - decoded <- Decode.decodeStack stack - pure - [ show a - | AnnFrame _ (Box ann) <- ssc_stack decoded - , StackAnnotation a <- [unsafeCoerce ann] - ] +import GHC.Exts.Heap.Closures (GenStgStackClosure) {-# NOINLINE printAnnotationStack #-} printAnnotationStack :: [String] -> IO () @@ -47,8 +37,8 @@ baz = annotateCallStackM $ do decodeAnnotationFrames >>= printAnnotationStack bar :: IO () -bar = annotateCallStackM $ annotateStackM "bar" $ do - putStrLn "Some more ork in bar" +bar = annotateCallStackM $ annotateStringM "bar" $ do + putStrLn "Some more work in bar" print (fib 21) decodeAnnotationFrames >>= printAnnotationStack @@ -56,3 +46,23 @@ fib :: Int -> Int fib n | n <= 1 = 1 | otherwise = fib (n - 1) + fib (n - 2) + +{-# NOINLINE decodeAnnotationFrames #-} +decodeAnnotationFrames :: IO [String] +decodeAnnotationFrames = do + stack <- CloneStack.cloneMyStack + decoded <- Decode.decodeStack stack + pure $ unwindStack decoded + +unwindStack :: GenStgStackClosure Box -> [String] +unwindStack stack_closure = + [ ann + | a <- ssc_stack stack_closure + , ann <- case a of + AnnFrame _ (Box ann) -> + [ displayStackAnnotation a + | SomeStackAnnotation a <- [unsafeCoerce ann] + ] + UnderflowFrame _ underflow_stack_closure -> unwindStack underflow_stack_closure + _ -> [] + ] ===================================== libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout ===================================== @@ -1,11 +1,11 @@ Start some work 10946 Annotation stack: -main:Main ann_frame002.hs:35-7:35-10 -main:Main ann_frame002.hs:35-3:35-6 +ann_frame002.hs:25:7 in main:Main +ann_frame002.hs:25:3 in main:Main Finish some work Some more ork in bar 17711 Annotation stack: -"bar" -main:Main ann_frame002.hs:50-7:50-25 +bar +ann_frame002.hs:40:7 in main:Main ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs ===================================== @@ -37,6 +37,14 @@ data EnabledBacktraceMechanisms = , ipeBacktraceEnabled :: !Bool } +data DisplayBacktraceMechanisms = + DisplayBacktraceMechanisms + { displayCostCentreBacktrace :: Ptr CCS.CostCentreStack -> String + , displayHasCallStackBacktrace :: HCS.CallStack -> String + , displayExecutionBacktrace :: [ExecStack.Location] -> String + , displayIpeBacktrace :: CloneStack.StackSnapshot -> String + } + defaultEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms defaultEnabledBacktraceMechanisms = EnabledBacktraceMechanisms { costCentreBacktraceEnabled = False @@ -45,6 +53,19 @@ defaultEnabledBacktraceMechanisms = EnabledBacktraceMechanisms , ipeBacktraceEnabled = False } +defaultDisplayBacktraceMechanisms :: DisplayBacktraceMechanisms +defaultDisplayBacktraceMechanisms = DisplayBacktraceMechanisms + { displayCostCentreBacktrace = unlines . map (indent 2) . unsafePerformIO . CCS.ccsToStrings + , displayHasCallStackBacktrace = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack + , displayExecutionBacktrace = unlines . map (indent 2 . flip ExecStack.showLocation "") + , displayIpeBacktrace = unlines . map (indent 2 . CloneStack.prettyStackEntry) . unsafePerformIO . CloneStack.decode + } + where + indent :: Int -> String -> String + indent n s = replicate n ' ' ++ s + + prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc + backtraceMechanismEnabled :: BacktraceMechanism -> EnabledBacktraceMechanisms -> Bool backtraceMechanismEnabled bm = case bm of @@ -69,6 +90,11 @@ enabledBacktraceMechanismsRef = unsafePerformIO $ newIORef defaultEnabledBacktraceMechanisms {-# NOINLINE enabledBacktraceMechanismsRef #-} +displayBacktraceMechanismsRef :: IORef DisplayBacktraceMechanisms +displayBacktraceMechanismsRef = + unsafePerformIO $ newIORef defaultDisplayBacktraceMechanisms +{-# NOINLINE displayBacktraceMechanismsRef #-} + -- | Returns the currently enabled 'BacktraceMechanism's. getEnabledBacktraceMechanisms :: IO EnabledBacktraceMechanisms getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanismsRef @@ -86,37 +112,41 @@ setBacktraceMechanismState bm enabled = do _ <- atomicModifyIORef'_ enabledBacktraceMechanismsRef (setBacktraceMechanismEnabled bm enabled) return () +-- TODO @fendor +getDisplayBacktraceMechanisms :: IO DisplayBacktraceMechanisms +getDisplayBacktraceMechanisms = readIORef displayBacktraceMechanismsRef + +-- TODO @fendor: +setDisplayBacktraceMechanismsState :: DisplayBacktraceMechanisms -> IO () +setDisplayBacktraceMechanismsState dbm = do + _ <- atomicModifyIORef'_ displayBacktraceMechanismsRef (const dbm) + return () + -- | A collection of backtraces. data Backtraces = Backtraces { btrCostCentre :: Maybe (Ptr CCS.CostCentreStack), + btrDisplayCostCentre :: Ptr CCS.CostCentreStack -> String, btrHasCallStack :: Maybe HCS.CallStack, + btrDisplayHasCallStack :: HCS.CallStack -> String, btrExecutionStack :: Maybe [ExecStack.Location], - btrIpe :: Maybe [CloneStack.StackEntry] + btrDisplayExecutionStack :: [ExecStack.Location] -> String, + btrIpe :: Maybe CloneStack.StackSnapshot, + btrDisplayIpe :: CloneStack.StackSnapshot -> String } -- | Render a set of backtraces to a human-readable string. displayBacktraces :: Backtraces -> String displayBacktraces bts = concat - [ displayOne "Cost-centre stack backtrace" btrCostCentre displayCc - , displayOne "Native stack backtrace" btrExecutionStack displayExec - , displayOne "IPE backtrace" btrIpe displayIpe - , displayOne "HasCallStack backtrace" btrHasCallStack displayHsc + [ displayOne "Cost-centre stack backtrace" btrCostCentre btrDisplayCostCentre + , displayOne "Native stack backtrace" btrExecutionStack btrDisplayExecutionStack + , displayOne "IPE backtrace" btrIpe btrDisplayIpe + , displayOne "HasCallStack backtrace" btrHasCallStack btrDisplayHasCallStack ] where - indent :: Int -> String -> String - indent n s = replicate n ' ' ++ s - - -- The unsafePerformIO here is safe as we don't currently unload cost-centres. - displayCc = unlines . map (indent 2) . unsafePerformIO . CCS.ccsToStrings - displayExec = unlines . map (indent 2 . flip ExecStack.showLocation "") - displayIpe = unlines . map (indent 2 . CloneStack.prettyStackEntry) - displayHsc = unlines . map (indent 2 . prettyCallSite) . HCS.getCallStack - where prettyCallSite (f, loc) = f ++ ", called at " ++ HCS.prettySrcLoc loc - - displayOne :: String -> (Backtraces -> Maybe rep) -> (rep -> String) -> String + displayOne :: String -> (Backtraces -> Maybe rep) -> (Backtraces -> rep -> String) -> String displayOne label getBt displ - | Just bt <- getBt bts = concat [label, ":\n", displ bt] + | Just bt <- getBt bts = concat [label, ":\n", displ bts bt] | otherwise = "" instance ExceptionAnnotation Backtraces where @@ -125,12 +155,14 @@ instance ExceptionAnnotation Backtraces where -- | Collect a set of 'Backtraces'. collectBacktraces :: (?callStack :: CallStack) => IO Backtraces collectBacktraces = HCS.withFrozenCallStack $ do - getEnabledBacktraceMechanisms >>= collectBacktraces' + bm <- getEnabledBacktraceMechanisms + dpm <- getDisplayBacktraceMechanisms + collectBacktraces' bm dpm collectBacktraces' :: (?callStack :: CallStack) - => EnabledBacktraceMechanisms -> IO Backtraces -collectBacktraces' enabled = HCS.withFrozenCallStack $ do + => EnabledBacktraceMechanisms -> DisplayBacktraceMechanisms -> IO Backtraces +collectBacktraces' enabled renderers = HCS.withFrozenCallStack $ do let collect :: BacktraceMechanism -> IO (Maybe a) -> IO (Maybe a) collect mech f | backtraceMechanismEnabled mech enabled = f @@ -144,14 +176,17 @@ collectBacktraces' enabled = HCS.withFrozenCallStack $ do ipe <- collect IPEBacktrace $ do stack <- CloneStack.cloneMyStack - stackEntries <- CloneStack.decode stack - return (Just stackEntries) + return (Just stack) hcs <- collect HasCallStackBacktrace $ do return (Just ?callStack) return (Backtraces { btrCostCentre = ccs + , btrDisplayCostCentre = displayCostCentreBacktrace renderers , btrHasCallStack = hcs + , btrDisplayHasCallStack = displayHasCallStackBacktrace renderers , btrExecutionStack = exec + , btrDisplayExecutionStack = displayExecutionBacktrace renderers , btrIpe = ipe + , btrDisplayIpe = displayIpeBacktrace renderers }) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9d4ecb791f07faf207eadb3e9fb4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9d4ecb791f07faf207eadb3e9fb4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/romes/26202
by Rodrigo Mesquita (＠alt-romes) 16 Jul '25

16 Jul '25

Rodrigo Mesquita pushed new branch wip/romes/26202 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/26202 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/since_docs] 2 commits: Add since tag and more docs for do-clever-arg-eta-expansion
by Andreas Klebinger (＠AndreasK) 16 Jul '25

16 Jul '25

Andreas Klebinger pushed to branch wip/andreask/since_docs at Glasgow Haskell Compiler / GHC Commits: 699deef5 by Andreas Klebinger at 2025-07-16T11:20:32+02:00 Add since tag and more docs for do-clever-arg-eta-expansion Fixes #26113 - - - - - cc4a8163 by Andreas Klebinger at 2025-07-16T11:20:51+02:00 Add since tag for -fexpose-overloaded-unfoldings Fixes #26112 - - - - - 1 changed file: - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -547,16 +547,24 @@ as such you shouldn't need to set any of them explicitly. A flag Eta-expand let-bindings to increase their arity. .. ghc-flag:: -fdo-clever-arg-eta-expansion - :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`. + :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-do-clever-arg-eta-expansion :category: :default: off + :since: 9.10.1 Eta-expand arguments to increase their arity to avoid allocating unnecessary thunks for them. + For example in code like `foo = f (g x)` this flag will determine which analysis + is used to decide the arity of `g x`, with the goal of avoiding a thunk for `g x` + in cases where `g` is a function with an arity higher than one. + + Enabling the flag enables a more sophisticated analysis, resulting in better + runtime but longer compile time. + .. ghc-flag:: -feager-blackholing :shortdesc: Turn on :ref:`eager blackholing <parallel-compile-options>` :type: dynamic @@ -617,6 +625,7 @@ as such you shouldn't need to set any of them explicitly. A flag :category: :default: off + :since: 9.12.1 This experimental flag is a slightly less heavy weight alternative to :ghc-flag:`-fexpose-all-unfoldings`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58721dd46fbf04c945f10ac794a4e9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58721dd46fbf04c945f10ac794a4e9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ann-frame] 61 commits: Consider `PromotedDataCon` in `tyConStupidTheta`
by Hannes Siebenhandl (＠fendor) 16 Jul '25

16 Jul '25

Hannes Siebenhandl pushed to branch wip/fendor/ann-frame at Glasgow Haskell Compiler / GHC Commits: 8d33d048 by Berk Özkütük at 2025-07-07T20:42:20-04:00 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. - - - - - a26243fd by Ryan Hendrickson at 2025-07-07T20:43:07-04:00 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. - - - - - 0fb24420 by Rodrigo Mesquita at 2025-07-07T20:43:49-04:00 hadrian: Fallback logic for internal interpreter When determining whether to build the internal interpreter, the `make` build system had a fallback case for platforms not in the list of explicitly-supported operating systems and architectures. This fallback says we should try to build the internal interpreter if building dynamic GHC programs (if the architecture is unknown). Fixes #24098 - - - - - fe925bd4 by Ben Gamari at 2025-07-07T20:44:30-04:00 users-guide: Reference Wasm FFI section - - - - - 5856284b by Ben Gamari at 2025-07-07T20:44:30-04:00 users-guide: Fix too-short heading warning - - - - - a48dcdf3 by Duncan Coutts at 2025-07-07T20:45:18-04:00 Reorganise documentation for allocate* functions Consolodate interface information into the .h file, keeping just implementation details in the .c file. Use Notes stlye in the .h file and refer to notes from the .c file. - - - - - de5b528c by Duncan Coutts at 2025-07-07T20:45:18-04:00 Introduce common utilities for allocating arrays The intention is to share code among the several places that do this already. - - - - - b321319d by Duncan Coutts at 2025-07-07T20:45:18-04:00 Use new array alloc utils in Heap.c The CMM primop can now report heap overflow. - - - - - 1d557ffb by Duncan Coutts at 2025-07-07T20:45:18-04:00 Use new array alloc utils in ThreadLabels.c Replacing a local utility. - - - - - e59a1430 by Duncan Coutts at 2025-07-07T20:45:18-04:00 Use new array alloc utils in Threads.c Replacing local open coded version. - - - - - 482df1c9 by Duncan Coutts at 2025-07-07T20:45:18-04:00 Add exitHeapOverflow helper utility This will be useful with the array alloc functions, since unlike allocate/allocateMaybeFail, they do not come in two versions. So if it's not convenient to propagate failure, then one can use this. - - - - - 4d3ec8f9 by Duncan Coutts at 2025-07-07T20:45:18-04:00 Use new array alloc utils in Weak.c Also add a cpp macro CCS_SYSTEM_OR_NULL which does what it says. The benefit of this is that it allows us to referece CCS_SYSTEM even when we're not in PROFILING mode. That makes abstracting over profiling vs normal mode a lot easier. - - - - - 0c4f2fde by Duncan Coutts at 2025-07-07T20:45:18-04:00 Convert the array alloc primops to use the new array alloc utils - - - - - a3354ad9 by Duncan Coutts at 2025-07-07T20:45:18-04:00 While we're at it, add one missing 'likely' hint To a cmm primops that raises an exception, like the others now do. - - - - - 33b546bd by meooow25 at 2025-07-07T20:46:09-04:00 Keep scanl' strict in the head on rewrite `scanl'` forces elements to WHNF when the corresponding `(:)`s are forced. The rewrite rule for `scanl'` missed forcing the first element, which is fixed here with a `seq`. - - - - - 8a69196e by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00 debugger/rts: Allow toggling step-in per thread The RTS global flag `rts_stop_next_breakpoint` globally sets the interpreter to stop at the immediate next breakpoint. With this commit, single step mode can additionally be set per thread in the TSO flag (TSO_STOP_NEXT_BREAKPOINT). Being able to toggle "stop at next breakpoint" per thread is an important requirement for implementing "stepping out" of a function in a multi-threaded context. And, more generally, having a per-thread flag for single-stepping paves the way for multi-threaded debugging. That said, when we want to enable "single step" mode for the whole interpreted program we still want to stop at the immediate next breakpoint, whichever thread it belongs to. That's why we also keep the global `rts_stop_next_breakpoint` flag, with `rts_enableStopNextBreakpointAll` and `rts_disableStopNextBreakpointAll` helpers. Preparation for #26042 - - - - - 73d3f864 by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00 docs: Case continuation BCOs This commit documents a subtle interaction between frames for case BCOs and their parents frames. Namely, case continuation BCOs may refer to (non-local) variables that are part of the parent's frame. The note expanding a bit on these details is called [Case continuation BCOs] - - - - - d7aeddcf by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00 debugger: Implement step-out feature Implements support for stepping-out of a function (aka breaking right after returning from a function) in the interactive debugger. It also introduces a GHCi command :stepout to step-out of a function being debugged in the interpreter. The feature is described as: Stop at the first breakpoint immediately after returning from the current function scope. Known limitations: because a function tail-call does not push a stack frame, if step-out is used inside of a function that was tail-called, execution will not be returned to its caller, but rather its caller's first non-tail caller. On the other hand, it means the debugger follows the more realistic execution of the program. In the following example: .. code-block:: none f = do a b <--- (1) set breakpoint then step in here c b = do ... d <--- (2) step-into this tail call d = do ... something <--- (3) step-out here ... Stepping-out will stop execution at the `c` invokation in `f`, rather than stopping at `b`. The key idea is simple: When step-out is enabled, traverse the runtime stack until a continuation BCO is found -- and enable the breakpoint heading that BCO explicitly using its tick-index. The details are specified in `Note [Debugger: Step-out]` in `rts/Interpreter.c`. Since PUSH_ALTS BCOs (representing case continuations) were never headed by a breakpoint (unlike the case alternatives they push), we introduced the BRK_ALTS instruction to allow the debugger to set a case continuation to stop at the breakpoint heading the alternative that is taken. This is further described in `Note [Debugger: BRK_ALTS]`. Fixes #26042 - - - - - 5d9adf51 by Rodrigo Mesquita at 2025-07-08T07:39:47-04:00 debugger: Filter step-out stops by SrcSpan To implement step-out, the RTS looks for the first continuation frame on the stack and explicitly enables its entry breakpoint. However, some continuations will be contained in the function from which step-out was initiated (trivial example is a case expression). Similarly to steplocal, we will filter the breakpoints at which the RTS yields to the debugger based on the SrcSpan. When doing step-out, only stop if the breakpoint is /not/ contained in the function from which we initiated it. This is especially relevant in monadic statements such as IO which is compiled to a long chain of case expressions. See Note [Debugger: Filtering step-out stops] - - - - - 7677adcc by Cheng Shao at 2025-07-08T07:40:29-04:00 compiler: make ModBreaks serializable - - - - - 14f67c6d by Rodrigo Mesquita at 2025-07-08T07:40:29-04:00 refactor: "Inspecting the session" moved from GHC Moved utilities for inspecting the session from the GHC module to GHC.Driver.Session.Inspect Purely a clean up - - - - - 9d3f484a by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 cleanup: Pass the HUG to readModBreaks, not HscEnv A minor cleanup. The associated history and setupBreakpoint functions are changed accordingly. - - - - - b595f713 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 cleanup: Move readModBreaks to GHC.Runtime.Interpreter With some small docs changes - - - - - d223227a by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 cleanup: Move interpreterProfiled to Interp.Types Moves interpreterProfiled and interpreterDynamic to GHC.Runtime.Interpreter.Types from GHC.Runtime.Interpreter. - - - - - 7fdd0a3d by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 cleanup: Don't import GHC in Debugger.Breakpoints Remove the top-level import GHC from GHC.Runtime.Debugger.Breakpoints This makes the module dependencies more granular and cleans up the qualified imports from the code. - - - - - 5e4da31b by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 refactor: Use BreakpointId in Core and Ifaces - - - - - 741ac3a8 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 stg2bc: Derive BcM via ReaderT StateT A small refactor that simplifies GHC.StgToByteCode by deriving-via the Monad instances for BcM. This is done along the lines of previous similar refactors like 72b54c0760bbf85be1f73c1a364d4701e5720465. - - - - - 0414fcc9 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 refact: Split InternalModBreaks out of ModBreaks There are currently two competing ways of referring to a Breakpoint: 1. Using the Tick module + Tick index 2. Using the Info module + Info index 1. The Tick index is allocated during desugaring in `mkModBreaks`. It is used to refer to a breakpoint associated to a Core Tick. For a given Tick module, there are N Ticks indexed by Tick index. 2. The Info index is allocated during code generation (in StgToByteCode) and uniquely identifies the breakpoints at runtime (and is indeed used to determine which breakpoint was hit at runtime). Why we need both is described by Note [Breakpoint identifiers]. For every info index we used to keep a `CgBreakInfo`, a datatype containing information relevant to ByteCode Generation, in `ModBreaks`. This commit splits out the `IntMap CgBreakInfo` out of `ModBreaks` into a new datatype `InternalModBreaks`. - The purpose is to separate the `ModBreaks` datatype, which stores data associated from tick-level information which is fixed after desugaring, from the unrelated `IntMap CgBreakInfo` information accumulated during bytecode generation. - We move `ModBreaks` to GHC.HsToCore.Breakpoints The new `InternalModBreaks` simply combines the `IntMap CgBreakInfo` with `ModBreaks`. After code generation we construct an `InternalModBreaks` with the `CgBreakInfo`s we accumulated and the existing `ModBreaks` and store that in the compiled BCO in `bc_breaks`. - Note that we previously only updated the `modBreaks_breakInfo` field of `ModBreaks` at this exact location, and then stored the updated `ModBreaks` in the same `bc_breaks`. - We put this new datatype in GHC.ByteCode.Breakpoints The rest of the pipeline for which CgBreakInfo is relevant is accordingly updated to also use `InternalModBreaks` - - - - - 2a097955 by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 cleanup: Use BreakpointIds in bytecode gen Small clean up to use BreakpointId and InternalBreakpointId more uniformly in bytecode generation rather than using Module + Ix pairs - - - - - 0515cc2f by Rodrigo Mesquita at 2025-07-08T07:40:30-04:00 ghci: Allocate BreakArrays at link time only Previously, a BreakArray would be allocated with a slot for every tick in a module at `mkModBreaks`, in HsToCore. However, this approach has a few downsides: - It interleaves interpreter behaviour (allocating arrays for breakpoints) within the desugarer - It is inflexible in the sense it is impossible for the bytecode generator to add "internal" breakpoints that can be triggered at runtime, because those wouldn't have a source tick. (This is relevant for our intended implementation plan of step-out in #26042) - It ties the BreakArray indices to the *tick* indexes, while at runtime we would rather just have the *info* indexes (currently we have both because BreakArrays are indexed by the *tick* one). Paving the way for #26042 and #26064, this commit moves the allocation of BreakArrays to bytecode-loading time -- akin to what is done for CCS arrays. Since a BreakArray is allocated only when bytecode is linked, if a breakpoint is set (e.g. `:break 10`) before the bytecode is linked, there will exist no BreakArray to trigger the breakpoint in. Therefore, the function to allocate break arrays (`allocateBreakArrays`) is exposed and also used in GHC.Runtime.Eval to allocate a break array when a breakpoint is set, if it doesn't exist yet (in the linker env). - - - - - 8016561f by Simon Peyton Jones at 2025-07-08T07:41:13-04:00 Add a test for T26176 - - - - - 454cd682 by Simon Peyton Jones at 2025-07-08T07:41:13-04:00 Add test for #14010 This test started to work in GHC 9.6 and has worked since. This MR just adds a regression test - - - - - ea2c6673 by Teo Camarasu at 2025-07-08T13:24:43-04:00 Implement user-defined allocation limit handlers Allocation Limits allow killing a thread if they allocate more than a user-specified limit. We extend this feature to allow more versatile behaviour. - We allow not killing the thread if the limit is exceeded. - We allow setting a custom handler to be called when the limit is exceeded. User-specified allocation limit handlers run in a fresh thread and are passed the ThreadId of the thread that exceeded its limit. We introduce utility functions for getting and setting the allocation limits of other threads, so that users can reset the limit of a thread from a handler. Both of these are somewhat coarse-grained as we are unaware of the allocations in the current nursery chunk. We provide several examples of usages in testsuite/tests/rts/T22859.hs Resolves #22859 - - - - - 03e047f9 by Simon Hengel at 2025-07-08T13:25:25-04:00 Fix typo in using.rst - - - - - 67957854 by Ben Gamari at 2025-07-09T09:44:44-04:00 compiler: Import AnnotationWrapper from ghc-internal Since `GHC.Desugar` exported from `base` has been deprecated. - - - - - 813d99d6 by Ben Gamari at 2025-07-09T09:44:44-04:00 ghc-compact: Eliminate dependency on ghc-prim - - - - - 0ec952a1 by Ben Gamari at 2025-07-09T09:44:44-04:00 ghc-heap: Eliminate dependency on ghc-prim - - - - - 480074c3 by Ben Gamari at 2025-07-09T09:44:44-04:00 ghc-heap: Drop redundant import - - - - - 03455829 by Ben Gamari at 2025-07-09T09:44:45-04:00 ghc-prim: Bump version to 0.13.1 There are no interface changes from 0.13.0 but the implementation now lives in `ghc-internal`. - - - - - d315345a by Ben Gamari at 2025-07-09T09:44:45-04:00 template-haskell: Bump version number to 2.24.0.0 Bumps exceptions submodule. - - - - - 004c800e by Ben Gamari at 2025-07-09T09:44:45-04:00 Bump GHC version number to 9.14 - - - - - eb1a3816 by Ben Gamari at 2025-07-09T09:44:45-04:00 Bump parsec to 3.1.18.0 Bumps parsec submodule. - - - - - 86f83296 by Ben Gamari at 2025-07-09T09:44:45-04:00 unix: Bump to 2.8.7.0 Bumps unix submodule. - - - - - 89e13998 by Ben Gamari at 2025-07-09T09:44:45-04:00 binary: Bump to 0.8.9.3 Bumps binary submodule. - - - - - 55fff191 by Ben Gamari at 2025-07-09T09:44:45-04:00 Win32: Bump to 2.14.2.0 Bumps Win32 submodule. - - - - - 7dafa40c by Ben Gamari at 2025-07-09T09:44:45-04:00 base: Bump version to 4.22.0 Bumps various submodules. - - - - - ef03d8b8 by Rodrigo Mesquita at 2025-07-09T09:45:28-04:00 base: Export displayExceptionWithInfo This function should be exposed from base following CLC#285 Approved change in CLC#344 Fixes #26058 - - - - - 01d3154e by Wen Kokke at 2025-07-10T17:06:36+01:00 Fix documentation for HEAP_PROF_SAMPLE_STRING - - - - - ac259c48 by Wen Kokke at 2025-07-10T17:06:38+01:00 Fix documentation for HEAP_PROF_SAMPLE_COST_CENTRE - - - - - 2b4db9ba by Pi Delport at 2025-07-11T16:40:52-04:00 (Applicative docs typo: missing "one") - - - - - f707bab4 by Andreas Klebinger at 2025-07-12T14:56:16+01:00 Specialise: Improve specialisation by refactoring interestingDict This MR addresses #26051, which concerns missed type-class specialisation. The main payload of the MR is to completely refactor the key function `interestingDict` in GHC.Core.Opt.Specialise The main change is that we now also look at the structure of the dictionary we consider specializing on, rather than only the type. See the big `Note [Interesting dictionary arguments]` - - - - - ca7a9d42 by Simon Peyton Jones at 2025-07-12T14:56:16+01:00 Treat tuple dictionaries uniformly; don't unbox them See `Note [Do not unbox class dictionaries]` in DmdAnal.hs, sep (DNB1). This MR reverses the plan in #23398, which suggested a special case to unbox tuple dictionaries in worker/wrapper. But: - This was the cause of a pile of complexity in the specialiser (#26158) - Even with that complexity, specialision was still bad, very bad See https://gitlab.haskell.org/ghc/ghc/-/issues/19747#note_626297 And it's entirely unnecessary! Specialision works fine without unboxing tuple dictionaries. - - - - - be7296c9 by Andreas Klebinger at 2025-07-12T14:56:16+01:00 Remove complex special case from the type-class specialiser There was a pretty tricky special case in Specialise which is no longer necessary. * Historical Note [Floating dictionaries out of cases] * #26158 * #19747 https://gitlab.haskell.org/ghc/ghc/-/issues/19747#note_626297 This MR removes it. Hooray. - - - - - 4acf3a86 by Ben Gamari at 2025-07-15T05:46:32-04:00 configure: bump version to 9.15 - - - - - 45efaf71 by Teo Camarasu at 2025-07-15T05:47:13-04:00 rts/nonmovingGC: remove n_free We remove the nonmovingHeap.n_free variable. We wanted this to track the length of nonmovingHeap.free. But this isn't possible to do atomically. When this isn't accurate we can get a segfault by going past the end of the list. Instead, we just count the length of the list when we grab it in nonmovingPruneFreeSegment. Resolves #26186 - - - - - c635f164 by Ben Gamari at 2025-07-15T14:05:54-04:00 configure: Drop probing of ld.gold As noted in #25716, `gold` has been dropped from binutils-2.44. Fixes #25716. Metric Increase: size_hello_artifact_gzip size_hello_unicode_gzip ghc_prim_so - - - - - 637bb538 by Ben Gamari at 2025-07-15T14:05:55-04:00 testsuite/recomp015: Ignore stderr This is necessary since ld.bfd complains that we don't have a .note.GNU-stack section, potentially resulting in an executable stack. - - - - - d3cd4ec8 by Wen Kokke at 2025-07-15T14:06:39-04:00 Fix documentation for heap profile ID - - - - - ad923bf4 by Ben Gamari at 2025-07-16T11:17:04+02:00 Annotate frame - - - - - f2285a96 by fendor at 2025-07-16T11:17:04+02:00 WIP: Introduce stack frame annotation helpers and extend ghc-heap stack decoder - - - - - ff9d4ecb by fendor at 2025-07-16T11:17:05+02:00 WIP: base: extend Backtraces to allow configuration of stack decoders - - - - - 236 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - + compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config.hs - + compiler/GHC/Driver/Session/Inspect.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - − compiler/GHC/Types/Breakpoint.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/eventlog-formats.rst - docs/users_guide/exts/doandifthenelse.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/ghci.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - libraries/Win32 - libraries/array - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Control/Exception.hs - libraries/binary - libraries/deepseq - libraries/directory - libraries/exceptions - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/GHC/Compact.hs - libraries/ghc-compact/GHC/Compact/Serialized.hs - libraries/ghc-compact/ghc-compact.cabal - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - + libraries/ghc-experimental/src/System/Mem/Experimental.hs - libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/InfoTable.hsc - libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc - libraries/ghc-heap/GHC/Exts/Stack.hs - libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - libraries/ghc-heap/cbits/Stack.cmm - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-heap/tests/parse_tso_flags.hs - + libraries/ghc-heap/tests/stack-annotation/Makefile - + libraries/ghc-heap/tests/stack-annotation/all.T - + libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout - + libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs - libraries/ghc-internal/src/GHC/Internal/Base.hs - libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-prim/changelog.md - libraries/ghc-prim/ghc-prim.cabal - + libraries/ghci/GHCi/Debugger.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/os-string - libraries/parsec - libraries/process - libraries/semaphore-compat - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/text - libraries/unix - m4/find_ld.m4 - + rts/AllocArray.c - + rts/AllocArray.h - rts/ClosureFlags.c - rts/Disassembler.c - rts/Heap.c - rts/Interpreter.c - rts/Interpreter.h - rts/LdvProfile.c - rts/Prelude.h - rts/PrimOps.cmm - rts/Printer.c - rts/RetainerProfile.c - rts/RtsStartup.c - rts/RtsSymbols.c - rts/RtsUtils.c - rts/Schedule.c - rts/StgMiscClosures.cmm - rts/ThreadLabels.c - rts/Threads.c - rts/TraverseHeap.c - rts/Weak.c - rts/external-symbols.list.in - rts/include/Rts.h - rts/include/rts/Bytecodes.h - rts/include/rts/Constants.h - rts/include/rts/prof/CCS.h - rts/include/rts/storage/ClosureTypes.h - rts/include/rts/storage/Closures.h - rts/include/rts/storage/GC.h - rts/include/rts/storage/Heap.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/js/profiling.js - rts/rts.cabal - rts/sm/Compact.c - rts/sm/Evac.c - rts/sm/NonMoving.c - rts/sm/NonMoving.h - rts/sm/NonMovingAllocate.c - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Scav.c - rts/sm/Storage.c - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/dmdanal/should_compile/T23398.hs - testsuite/tests/dmdanal/should_compile/T23398.stderr - testsuite/tests/driver/recomp015/all.T - + testsuite/tests/ghci.debugger/scripts/T26042b.hs - + testsuite/tests/ghci.debugger/scripts/T26042b.script - + testsuite/tests/ghci.debugger/scripts/T26042b.stdout - + testsuite/tests/ghci.debugger/scripts/T26042c.hs - + testsuite/tests/ghci.debugger/scripts/T26042c.script - + testsuite/tests/ghci.debugger/scripts/T26042c.stdout - + testsuite/tests/ghci.debugger/scripts/T26042d.hs - + testsuite/tests/ghci.debugger/scripts/T26042d.script - + testsuite/tests/ghci.debugger/scripts/T26042d.stdout - + testsuite/tests/ghci.debugger/scripts/T26042e.hs - + testsuite/tests/ghci.debugger/scripts/T26042e.script - + testsuite/tests/ghci.debugger/scripts/T26042e.stdout - + testsuite/tests/ghci.debugger/scripts/T26042f.hs - + testsuite/tests/ghci.debugger/scripts/T26042f.script - + testsuite/tests/ghci.debugger/scripts/T26042f1.stderr - + testsuite/tests/ghci.debugger/scripts/T26042f1.stdout - + testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - + testsuite/tests/ghci.debugger/scripts/T26042g.hs - + testsuite/tests/ghci.debugger/scripts/T26042g.script - + testsuite/tests/ghci.debugger/scripts/T26042g.stdout - testsuite/tests/ghci.debugger/scripts/all.T - + testsuite/tests/indexed-types/should_fail/T26176.hs - + testsuite/tests/indexed-types/should_fail/T26176.stderr - testsuite/tests/indexed-types/should_fail/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - + testsuite/tests/perf/should_run/SpecTyFamRun.hs - + testsuite/tests/perf/should_run/SpecTyFamRun.stdout - + testsuite/tests/perf/should_run/SpecTyFam_Import.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/rts/T22859.hs - + testsuite/tests/rts/T22859.stderr - testsuite/tests/rts/all.T - + testsuite/tests/simplCore/should_compile/T26051.hs - + testsuite/tests/simplCore/should_compile/T26051.stderr - + testsuite/tests/simplCore/should_compile/T26051_Import.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T14010.hs - testsuite/tests/typecheck/should_compile/all.T - utils/deriveConstants/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/haddock/CHANGES.md - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/haddock/haddock-library/haddock-library.cabal - utils/haddock/haddock-test/haddock-test.cabal - utils/haddock/haddock-test/src/Test/Haddock/Config.hs - utils/haddock/haddock.cabal - utils/haddock/html-test/ref/Bug1004.html - + utils/haddock/html-test/ref/Bug25739.html - + utils/haddock/html-test/src/Bug25739.hs - utils/hsc2hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/561cb31e29e74aea7159b7ea275987… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/561cb31e29e74aea7159b7ea275987… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/since_docs
by Andreas Klebinger (＠AndreasK) 16 Jul '25

16 Jul '25

Andreas Klebinger pushed new branch wip/andreask/since_docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/since_docs You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T23109] 11 commits: configure: Drop probing of ld.gold
by Simon Peyton Jones (＠simonpj) 16 Jul '25

16 Jul '25

Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: c635f164 by Ben Gamari at 2025-07-15T14:05:54-04:00 configure: Drop probing of ld.gold As noted in #25716, `gold` has been dropped from binutils-2.44. Fixes #25716. Metric Increase: size_hello_artifact_gzip size_hello_unicode_gzip ghc_prim_so - - - - - 637bb538 by Ben Gamari at 2025-07-15T14:05:55-04:00 testsuite/recomp015: Ignore stderr This is necessary since ld.bfd complains that we don't have a .note.GNU-stack section, potentially resulting in an executable stack. - - - - - d3cd4ec8 by Wen Kokke at 2025-07-15T14:06:39-04:00 Fix documentation for heap profile ID - - - - - d25469c8 by Simon Peyton Jones at 2025-07-16T09:19:35+01:00 Make injecting implicit bindings into its own pass Previously we were injecting "impliicit bindings" (data constructor worker and wrappers etc) - both at the end of CoreTidy, - and at the start of CorePrep This is unpleasant and confusing. This patch puts it it its own pass, addImplicitBinds, which runs between the two. The function `GHC.CoreToStg.AddImplicitBinds.addImplicitBinds` now takes /all/ TyCons, not just the ones for algebraic data types. That change ripples through to - corePrepPgm - doCodeGen - byteCodeGen All take [TyCon] which includes all TyCons - - - - - a10a60b8 by Simon Peyton Jones at 2025-07-16T09:25:40+01:00 Implement unary classes The big change is described exhaustively in Note [Unary class magic] in GHC.Core.TyCon Other changes * We never unbox class dictionaries in worker/wrapper. This has been true for some time now, but the logic is now centralised in functions in GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg` See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils. * Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels. I can't remember if I actually changed any behaviour here, but if so it's only in a corner cases. * Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning True for (##). * Remove redundant Role argument to `liftCoSubstWithEx`. It was always Representational. * I refactored evidence generation in the constraint solver: * Made GHC.Tc.Types.Evidence contain better abstactions for evidence generation. * I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents elsewhere. It wasn't paying its way. * Made evidence for implicit parameters go via a proper abstraction. * Fix inlineBoringOk; see (IB6) in Note [inlineBoringOk] This fixes a slowdown in `countdownEffectfulDynLocal` in the `effectful` library. Smaller things * Rename `isDataTyCon` to `isBoxedDataTyCon`. * GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role, so I baked that into the function and removed the argument. * Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling `not isNewTyCon` at the call sites; more explicit. * Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its behaviour * Moved `decomposeIPPred` to GHC.Core.Predicate Compile time performance changes: geo. mean +0.1% minimum -6.8% maximum +14.4% The +14% one is in T21839c, where it seems that a bit more inlining is taking place. That seems acceptable; and the average change is small Metric Decrease: LargeRecord T12227 T16577 T21839r T5642 Metric Increase: T15164 T21839c T5321FD T5321Fun WWRec - - - - - 4abd7ccd by Simon Peyton Jones at 2025-07-16T09:26:40+01:00 Accept GHCi debugger output change @alt-romes says this is fine - - - - - 31c36c3f by Simon Peyton Jones at 2025-07-16T09:26:40+01:00 Renaming around predicate types .. we were (as it turned out) abstracting over type-class selectors in SPECIALISATION rules! - - - - - da158a83 by Simon Peyton Jones at 2025-07-16T09:26:40+01:00 Small hacky fix to specUnfolding ...just using mkApps instead of mkCoreApps (This part is likely to change again in a future commit.) - - - - - 765193c3 by Simon Peyton Jones at 2025-07-16T09:26:40+01:00 Slight improvement to pre/postInlineUnconditionally Avoids an extra simplifier iteration - - - - - 8dc41c97 by Simon Peyton Jones at 2025-07-16T09:26:40+01:00 Fix a long-standing assertion error in normSplitTyConApp_maybe - - - - - 4acb3c52 by Simon Peyton Jones at 2025-07-16T09:47:45+01:00 Add comment to coercion optimiser - - - - - 105 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg.hs - + compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - − compiler/GHC/Tc/Types/EvTerm.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/TyThing.hs - compiler/GHC/Types/Var.hs - compiler/ghc.cabal.in - docs/users_guide/eventlog-formats.rst - m4/find_ld.m4 - testsuite/tests/core-to-stg/T24124.stderr - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/dmdanal/should_compile/T16029.stdout - testsuite/tests/dmdanal/sigs/T21119.stderr - testsuite/tests/dmdanal/sigs/T21888.stderr - testsuite/tests/driver/recomp015/all.T - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break024.stdout - testsuite/tests/indexed-types/should_compile/T2238.hs - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T23907.stderr - testsuite/tests/roles/should_compile/Roles14.stderr - testsuite/tests/roles/should_compile/Roles3.stderr - testsuite/tests/roles/should_compile/Roles4.stderr - testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T17366.stderr - testsuite/tests/simplCore/should_compile/T17966.stderr - testsuite/tests/simplCore/should_compile/T22309.stderr - testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr - testsuite/tests/simplCore/should_compile/T23307.stderr - testsuite/tests/simplCore/should_compile/T23307a.stderr - testsuite/tests/simplCore/should_compile/T25389.stderr - testsuite/tests/simplCore/should_compile/T25713.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/simplStg/should_compile/T15226b.stderr - testsuite/tests/tcplugins/CtIdPlugin.hs - testsuite/tests/typecheck/should_compile/Makefile - testsuite/tests/typecheck/should_compile/T12763.stderr - testsuite/tests/typecheck/should_compile/T14774.stdout - testsuite/tests/typecheck/should_compile/T18406b.stderr - testsuite/tests/typecheck/should_compile/T18529.stderr - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/unboxedsums/unpack_sums_7.stdout - testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs - testsuite/tests/wasm/should_run/control-flow/RunWasm.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7607b376e22cfcde1b6d3beb0c27d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7607b376e22cfcde1b6d3beb0c27d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: configure: Drop probing of ld.gold
by Marge Bot (＠marge-bot) 16 Jul '25

16 Jul '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c635f164 by Ben Gamari at 2025-07-15T14:05:54-04:00 configure: Drop probing of ld.gold As noted in #25716, `gold` has been dropped from binutils-2.44. Fixes #25716. Metric Increase: size_hello_artifact_gzip size_hello_unicode_gzip ghc_prim_so - - - - - 637bb538 by Ben Gamari at 2025-07-15T14:05:55-04:00 testsuite/recomp015: Ignore stderr This is necessary since ld.bfd complains that we don't have a .note.GNU-stack section, potentially resulting in an executable stack. - - - - - d3cd4ec8 by Wen Kokke at 2025-07-15T14:06:39-04:00 Fix documentation for heap profile ID - - - - - 73082769 by Ben Gamari at 2025-07-15T16:56:38-04:00 Bump win32-tarballs to v0.9 - - - - - 3b63b254 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle null terminated string tables As of `llvm-ar` now emits filename tables terminated with null characters instead of the usual POSIX `/\n` sequence. Fixes #26150. - - - - - 195f6527 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: rename label so name doesn't conflict with param - - - - - 63373b95 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Handle API set symbol versioning conflicts - - - - - 48e9aa3e by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Mark API set symbols as HIDDEN and correct symbol type - - - - - 959e827a by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Implement WEAK EXTERNAL undef redirection by target symbol name - - - - - 65f19293 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/LoadArchive: Handle string table entries terminated with / llvm-ar appears to terminate string table entries with `/\n` [1]. This matters in the case of thin archives, since the filename is used. In the past this worked since `llvm-ar` would produce archives with "small" filenames when possible. However, now it appears to always use the string table. [1] https://github.com/llvm/llvm-project/blob/bfb686bb5ba503e9386dc899e1ebbe248… - - - - - 9cbb3ef5 by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Mark T12497 as fixed Thanks to the LLVM toolchain update. Closes #22694. - - - - - 2854407e by Ben Gamari at 2025-07-15T16:56:39-04:00 testsuite: Accept new output of T11223_link_order_a_b_2_fail on Windows The archive member number changed due to the fact that llvm-ar now uses a string table. - - - - - 28439593 by Ben Gamari at 2025-07-15T16:56:39-04:00 rts/linker/PEi386: Implement IMAGE_REL_AMD64_SECREL This appears to now be used by libc++ as distributed by msys2. - - - - - 2b053755 by Tamar Christina at 2025-07-15T16:56:39-04:00 rts: Cleanup merge resolution residue in lookupSymbolInDLL_PEi386 and make safe without dependent - - - - - ec92df61 by Wen Kokke at 2025-07-16T04:36:02-04:00 Remove the `profile_id` parameter from various RTS functions. Various RTS functions took a `profile_id` parameter, intended to be used to distinguish parallel heap profile breakdowns (e.g., `-hT` and `-hi`). However, this feature was never implemented and the `profile_id` parameter was set to 0 throughout the RTS. This commit removes the parameter but leaves the hardcoded profile ID in the functions that emit the encoded eventlog events as to not change the protocol. The affected functions are `traceHeapProfBegin`, `postHeapProfBegin`, `traceHeapProfSampleString`, `postHeapProfSampleString`, `traceHeapProfSampleCostCentre`, and `postHeapProfSampleCostCentre`. - - - - - 3049e37d by Wen Kokke at 2025-07-16T04:36:02-04:00 Make `traceHeapProfBegin` an init event. - - - - - 16 changed files: - docs/users_guide/eventlog-formats.rst - m4/find_ld.m4 - mk/get-win32-tarballs.py - rts/ProfHeap.c - rts/RetainerSet.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/linker/LoadArchive.c - rts/linker/PEi386.c - testsuite/tests/driver/recomp015/all.T - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 - testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== docs/users_guide/eventlog-formats.rst ===================================== @@ -693,6 +693,8 @@ A single fixed-width event emitted during program start-up describing the sample :field String: retainer filter :field String: biography filter +The profile ID field is reserved for future use. + Cost centre definitions ^^^^^^^^^^^^^^^^^^^^^^^ @@ -792,6 +794,7 @@ Otherwise, a :event-type:`HEAP_PROF_SAMPLE_STRING` event is emitted instead. :field Word8: stack depth :field Word32[]: cost centre stack starting with inner-most (cost centre numbers) +The profile ID field is reserved for future use. String break-down ^^^^^^^^^^^^^^^^^ @@ -818,6 +821,8 @@ If the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`, a :event- :field Word64: heap residency in bytes :field String: sample label +The profile ID field is reserved for future use. + .. _time-profiler-events: Time profiler event log output ===================================== m4/find_ld.m4 ===================================== @@ -21,14 +21,7 @@ AC_DEFUN([FIND_LD],[ return fi - case $CPU in - i386) - # We refuse to use ld.gold on i386 due to #23579, which we don't - # have a good autoconf check for. - linkers="ld.lld ld" ;; - *) - linkers="ld.lld ld.gold ld" ;; - esac + linkers="ld.lld ld" # Manually iterate over possible names since we want to ensure that, e.g., # if ld.lld is installed but gcc doesn't support -fuse-ld=lld, that we ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,7 @@ import argparse import sys from sys import stderr -TARBALL_VERSION = '0.8' +TARBALL_VERSION = '0.9' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['x86_64', 'sources'] ===================================== rts/ProfHeap.c ===================================== @@ -557,7 +557,7 @@ initHeapProfiling(void) restore_locale(); - traceHeapProfBegin(0); + traceInitEvent(traceHeapProfBegin); } void @@ -896,17 +896,17 @@ dumpCensus( Census *census ) // Eventlog - traceHeapProfSampleString(0, "VOID", + traceHeapProfSampleString("VOID", (census->void_total * sizeof(W_))); - traceHeapProfSampleString(0, "LAG", + traceHeapProfSampleString("LAG", ((census->not_used - census->void_total) * sizeof(W_))); - traceHeapProfSampleString(0, "USE", + traceHeapProfSampleString("USE", ((census->used - census->drag_total) * sizeof(W_))); - traceHeapProfSampleString(0, "INHERENT_USE", + traceHeapProfSampleString("INHERENT_USE", (census->prim * sizeof(W_))); - traceHeapProfSampleString(0, "DRAG", + traceHeapProfSampleString("DRAG", (census->drag_total * sizeof(W_))); traceHeapProfSampleEnd(era); @@ -941,33 +941,33 @@ dumpCensus( Census *census ) switch (RtsFlags.ProfFlags.doHeapProfile) { case HEAP_BY_CLOSURE_TYPE: fprintf(hp_file, "%s", (char *)ctr->identity); - traceHeapProfSampleString(0, (char *)ctr->identity, + traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_INFO_TABLE: fprintf(hp_file, "%p", ctr->identity); char str[100]; sprintf(str, "%p", ctr->identity); - traceHeapProfSampleString(0, str, count * sizeof(W_)); + traceHeapProfSampleString(str, count * sizeof(W_)); break; #if defined(PROFILING) case HEAP_BY_CCS: fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, RtsFlags.ProfFlags.ccsLength); - traceHeapProfSampleCostCentre(0, (CostCentreStack *)ctr->identity, + traceHeapProfSampleCostCentre((CostCentreStack *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_ERA: fprintf(hp_file, "%" FMT_Word, (StgWord)ctr->identity); char str_era[100]; sprintf(str_era, "%" FMT_Word, (StgWord)ctr->identity); - traceHeapProfSampleString(0, str_era, count * sizeof(W_)); + traceHeapProfSampleString(str_era, count * sizeof(W_)); break; case HEAP_BY_MOD: case HEAP_BY_DESCR: case HEAP_BY_TYPE: fprintf(hp_file, "%s", (char *)ctr->identity); - traceHeapProfSampleString(0, (char *)ctr->identity, + traceHeapProfSampleString((char *)ctr->identity, count * sizeof(W_)); break; case HEAP_BY_RETAINER: ===================================== rts/RetainerSet.c ===================================== @@ -238,7 +238,7 @@ printRetainerSetShort(FILE *f, RetainerSet *rs, W_ total_size, uint32_t max_leng } } fputs(tmp, f); - traceHeapProfSampleString(0, tmp, total_size); + traceHeapProfSampleString(tmp, total_size); } /* ----------------------------------------------------------------------------- ===================================== rts/Trace.c ===================================== @@ -647,10 +647,10 @@ void traceTaskDelete_ (Task *task) } } -void traceHeapProfBegin(StgWord8 profile_id) +void traceHeapProfBegin(void) { if (eventlog_enabled) { - postHeapProfBegin(profile_id); + postHeapProfBegin(); } } void traceHeapBioProfSampleBegin(StgInt era, StgWord64 time) @@ -674,11 +674,10 @@ void traceHeapProfSampleEnd(StgInt era) } } -void traceHeapProfSampleString(StgWord8 profile_id, - const char *label, StgWord residency) +void traceHeapProfSampleString(const char *label, StgWord residency) { if (eventlog_enabled) { - postHeapProfSampleString(profile_id, label, residency); + postHeapProfSampleString(label, residency); } } @@ -718,11 +717,10 @@ void traceHeapProfCostCentre(StgWord32 ccID, } // This one is for .hp samples -void traceHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, StgWord residency) +void traceHeapProfSampleCostCentre(CostCentreStack *stack, StgWord residency) { if (eventlog_enabled) { - postHeapProfSampleCostCentre(profile_id, stack, residency); + postHeapProfSampleCostCentre(stack, residency); } } ===================================== rts/Trace.h ===================================== @@ -303,20 +303,18 @@ void traceTaskMigrate_ (Task *task, void traceTaskDelete_ (Task *task); -void traceHeapProfBegin(StgWord8 profile_id); +void traceHeapProfBegin(void); void traceHeapProfSampleBegin(StgInt era); void traceHeapBioProfSampleBegin(StgInt era, StgWord64 time); void traceHeapProfSampleEnd(StgInt era); -void traceHeapProfSampleString(StgWord8 profile_id, - const char *label, StgWord residency); +void traceHeapProfSampleString(const char *label, StgWord residency); #if defined(PROFILING) void traceHeapProfCostCentre(StgWord32 ccID, const char *label, const char *module, const char *srcloc, StgBool is_caf); -void traceHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, StgWord residency); +void traceHeapProfSampleCostCentre(CostCentreStack *stack, StgWord residency); void traceProfSampleCostCentre(Capability *cap, CostCentreStack *stack, StgWord ticks); @@ -369,14 +367,14 @@ void flushTrace(void); #define traceTaskCreate_(taskID, cap) /* nothing */ #define traceTaskMigrate_(taskID, cap, new_cap) /* nothing */ #define traceTaskDelete_(taskID) /* nothing */ -#define traceHeapProfBegin(profile_id) /* nothing */ +#define traceHeapProfBegin() /* nothing */ #define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */ #define traceIPE(ipe) /* nothing */ #define traceHeapProfSampleBegin(era) /* nothing */ #define traceHeapBioProfSampleBegin(era, time) /* nothing */ #define traceHeapProfSampleEnd(era) /* nothing */ -#define traceHeapProfSampleCostCentre(profile_id, stack, residency) /* nothing */ -#define traceHeapProfSampleString(profile_id, label, residency) /* nothing */ +#define traceHeapProfSampleCostCentre(stack, residency) /* nothing */ +#define traceHeapProfSampleString(label, residency) /* nothing */ #define traceConcMarkBegin() /* nothing */ #define traceConcMarkEnd(marked_obj_count) /* nothing */ ===================================== rts/eventlog/EventLog.c ===================================== @@ -95,6 +95,13 @@ bool eventlog_enabled; // protected by state_change_mutex to ensure * buffer size, EVENT_LOG_SIZE. We must ensure that no variable-length event * exceeds this limit. For this reason we impose maximum length limits on * fields which may have unbounded values. + * + * Note [Profile ID] + * ~~~~~~~~~~~~~~~~~ + * The profile ID field of eventlog entries is reserved for future use, + * with an eye towards supporting multiple parallel heap profiles. + * In the current RTS, the profile ID is hardcoded to 0. + * */ static const EventLogWriter *event_log_writer = NULL; @@ -1219,7 +1226,7 @@ static HeapProfBreakdown getHeapProfBreakdown(void) } } -void postHeapProfBegin(StgWord8 profile_id) +void postHeapProfBegin(void) { ACQUIRE_LOCK(&eventBufMutex); PROFILING_FLAGS *flags = &RtsFlags.ProfFlags; @@ -1244,7 +1251,8 @@ void postHeapProfBegin(StgWord8 profile_id) CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_BEGIN); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, TimeToNS(flags->heapProfileInterval)); postWord32(&eventBuf, getHeapProfBreakdown()); postStringLen(&eventBuf, flags->modSelector, modSelector_len); @@ -1286,8 +1294,7 @@ void postHeapProfSampleEnd(StgInt era) RELEASE_LOCK(&eventBufMutex); } -void postHeapProfSampleString(StgWord8 profile_id, - const char *label, +void postHeapProfSampleString(const char *label, StgWord64 residency) { ACQUIRE_LOCK(&eventBufMutex); @@ -1296,7 +1303,8 @@ void postHeapProfSampleString(StgWord8 profile_id, CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_STRING); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, residency); postStringLen(&eventBuf, label, label_len); RELEASE_LOCK(&eventBufMutex); @@ -1325,8 +1333,7 @@ void postHeapProfCostCentre(StgWord32 ccID, RELEASE_LOCK(&eventBufMutex); } -void postHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, +void postHeapProfSampleCostCentre(CostCentreStack *stack, StgWord64 residency) { ACQUIRE_LOCK(&eventBufMutex); @@ -1340,7 +1347,8 @@ void postHeapProfSampleCostCentre(StgWord8 profile_id, CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_HEAP_PROF_SAMPLE_COST_CENTRE); postPayloadSize(&eventBuf, len); - postWord8(&eventBuf, profile_id); + // See Note [Profile ID]. + postWord8(&eventBuf, 0); postWord64(&eventBuf, residency); postWord8(&eventBuf, depth); for (ccs = stack; ===================================== rts/eventlog/EventLog.h ===================================== @@ -163,14 +163,13 @@ void postTaskMigrateEvent (EventTaskId taskId, void postTaskDeleteEvent (EventTaskId taskId); -void postHeapProfBegin(StgWord8 profile_id); +void postHeapProfBegin(void); void postHeapProfSampleBegin(StgInt era); void postHeapBioProfSampleBegin(StgInt era, StgWord64 time_ns); void postHeapProfSampleEnd(StgInt era); -void postHeapProfSampleString(StgWord8 profile_id, - const char *label, +void postHeapProfSampleString(const char *label, StgWord64 residency); #if defined(PROFILING) @@ -180,8 +179,7 @@ void postHeapProfCostCentre(StgWord32 ccID, const char *srcloc, StgBool is_caf); -void postHeapProfSampleCostCentre(StgWord8 profile_id, - CostCentreStack *stack, +void postHeapProfSampleCostCentre(CostCentreStack *stack, StgWord64 residency); void postProfSampleCostCentre(Capability *cap, ===================================== rts/linker/LoadArchive.c ===================================== @@ -223,21 +223,22 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, char* gnuFileIndex, pathchar* path, size_t* thisFileNameSize, size_t* fileNameSize) { - int n; char *fileName = *fileName_; if (isdigit(fileName[1])) { - int i; - for (n = 2; isdigit(fileName[n]); n++) - ; - - fileName[n] = '\0'; - n = atoi(fileName + 1); if (gnuFileIndex == NULL) { errorBelch("loadArchive: GNU-variant filename " "without an index while reading from `%" PATH_FMT "'", path); return false; } + + int n; + for (n = 2; isdigit(fileName[n]); n++) + ; + + char *end; + fileName[n] = '\0'; + n = strtol(fileName + 1, &end, 10); if (n < 0 || n > gnuFileIndexSize) { errorBelch("loadArchive: GNU-variant filename " "offset %d out of range [0..%d] " @@ -245,17 +246,27 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, n, gnuFileIndexSize, path); return false; } - if (n != 0 && gnuFileIndex[n - 1] != '\n') { + + // Check that the previous entry ends with the expected + // end-of-string delimiter. +#if defined(mingw32_HOST_OS) +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n' || STR == '\0') +#else +#define IS_SYMBOL_DELIMITER(STR) (STR =='\n') +#endif + if (n != 0 && !IS_SYMBOL_DELIMITER(gnuFileIndex[n - 1])) { errorBelch("loadArchive: GNU-variant filename offset " "%d invalid (range [0..%d]) while reading " "filename from `%" PATH_FMT "'", n, gnuFileIndexSize, path); return false; } - for (i = n; gnuFileIndex[i] != '\n'; i++) + + int i; + for (i = n; !IS_SYMBOL_DELIMITER(gnuFileIndex[i]); i++) ; - size_t FileNameSize = i - n - 1; + size_t FileNameSize = i - n; if (FileNameSize >= *fileNameSize) { /* Double it to avoid potentially continually increasing it by 1 */ @@ -264,6 +275,13 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, "loadArchive(fileName)"); } memcpy(fileName, gnuFileIndex + n, FileNameSize); + + + /* llvm-ar terminates string table entries with `/\n`. */ + if (fileName[FileNameSize-1] == '/') { + FileNameSize--; + } + fileName[FileNameSize] = '\0'; *thisFileNameSize = FileNameSize; } ===================================== rts/linker/PEi386.c ===================================== @@ -342,6 +342,98 @@ Finally, we enter `ocResolve`, where we resolve relocations and and allocate jump islands (using the m32 allocator for backing storage) as necessary. + Note [Windows API Set] + ~~~~~~~~~~~~~~~~~~~~~~ + Windows has a concept called API Sets [1][2] which is intended to be Windows's + equivalent to glibc's symbolic versioning. It is also used to handle the API + surface difference between different device classes. e.g. the API might be + handled differently between a desktop and tablet. + + This is handled through two mechanisms: + + 1. Direct Forward: These use import libraries to manage to first level + redirection. So what used to be in ucrt.dll is now redirected based on + ucrt.lib. Every API now points to a possible different set of API sets + each following the API set contract: + + * The name must begin either with the string api- or ext-. + * Names that begin with api- represent APIs that exist on all Windows + editions that satisfy the API's version requirements. + * Names that begin with ext- represent APIs that may not exist on all + Windows editions. + * The name must end with the sequence l<n>-<n>-<n>, where n consists of + decimal digits. + * The body of the name can be alphanumeric characters, or dashes (-). + * The name is case insensitive. + + Here are some examples of API set contract names: + + - api-ms-win-core-ums-l1-1-0 + - ext-ms-win-com-ole32-l1-1-5 + - ext-ms-win-ntuser-window-l1-1-0 + - ext-ms-win-ntuser-window-l1-1-1 + + Forward references don't require anything special from the calling + application in that the Windows loader through "LoadLibrary" will + automatically load the right reference for you if given an API set + name including the ".dll" suffix. For example: + + INFO: DLL api-ms-win-eventing-provider-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-apiquery-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\ntdll.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-3.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-processthreads-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-registry-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-heap-l2-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-1.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-memory-l1-1-2.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + INFO: DLL api-ms-win-core-handle-l1-1-0.dll was redirected to C:\WINDOWS\SYSTEM32\kernelbase.dll by API set + + Which shows how the loader has redirected some of the references used + by ghci. + + Historically though we've treated shared libs lazily. We would load\ + the shared library, but not resolve the symbol immediately and wait until + the symbol is requested to iterate in order through the shared libraries. + + This assumes that you ever only had one version of a symbol. i.e. we had + an assumption that all exported symbols in different shared libraries + should be the same, because most of the time they come from re-exporting + from a base library. This is a bit of a weak assumption and doesn't hold + with API Sets. + + For that reason the loader now resolves symbols immediately, and because + we now resolve using BIND_NOW we must make sure that a symbol loaded + through an OC has precedent because the BIND_NOW refernce was not asked + for. For that reason we load the symbols for API sets with the + SYM_TYPE_DUP_DISCARD flag set. + + 2. Reverse forwarders: This is when the application has a direct reference + to the old name of an API. e.g. if GHC still used "msvcrt.dll" or + "ucrt.dll" we would have had to deal with this case. In this case the + loader intercepts the call and if it exists the dll is loaded. There is + an extra indirection as you go from foo.dll => api-ms-foo-1.dll => foo_imp.dll + + But if the API doesn't exist on the device it's resolved to a stub in the + API set that if called will result in an error should it be called [3]. + + This means that usages of GetProcAddress and LoadLibrary to check for the + existance of a function aren't safe, because they'll always succeed, but may + result in a pointer to the stub rather than the actual function. + + WHat does this mean for the RTS linker? Nothing. We don't have a fallback + for if the function doesn't exist. The RTS is merely just executing what + it was told to run. It's writers of libraries that have to be careful when + doing dlopen()/LoadLibrary. + + + [1] https://learn.microsoft.com/en-us/windows/win32/apiindex/windows-apisets + [2] https://mingwpy.github.io/ucrt.html#api-set-implementation + [3] https://learn.microsoft.com/en-us/windows/win32/apiindex/detect-api-set-ava… + */ #include "Rts.h" @@ -882,7 +974,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) goto error; } } else { - goto loaded; /* We're done. DLL has been loaded. */ + goto loaded_ok; /* We're done. DLL has been loaded. */ } } } @@ -890,7 +982,7 @@ addDLL_PEi386( const pathchar *dll_name, HINSTANCE *loaded ) // We failed to load goto error; -loaded: +loaded_ok: addLoadedDll(&loaded_dll_cache, dll_name, instance); addDLLHandle(buf, instance); if (loaded) { @@ -1055,7 +1147,8 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f // We must call `addDLL_PEi386` directly rather than `addDLL` because `addDLL` // is now a wrapper around `loadNativeObj` which acquires a lock which we // already have here. - const char* result = addDLL_PEi386(dll, NULL); + HINSTANCE instance; + const char* result = addDLL_PEi386(dll, &instance); stgFree(image); @@ -1069,6 +1162,28 @@ bool checkAndLoadImportLibrary( pathchar* arch_name, char* member_name, FILE* f } stgFree(dll); + + // See Note [Windows API Set] + // We must immediately tie the symbol to the shared library. The easiest + // way is to load the symbol immediately. We already have all the + // information so might as well + SymbolAddr* sym = lookupSymbolInDLL_PEi386 (symbol, instance, dll, NULL); + + // Could be an import descriptor etc, skip if no symbol. + if (!sym) + return true; + + // The symbol must have been found, and we can add it to the RTS symbol table + IF_DEBUG(linker, debugBelch("checkAndLoadImportLibrary: resolved symbol %s to %p\n", symbol, sym)); + // 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. + 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; } @@ -1198,7 +1313,7 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* it generates call *__imp_foo, and __imp_foo here has exactly the same semantics as in __imp_foo = GetProcAddress(..., "foo") */ - if (sym == NULL && strncmp (lbl, "__imp_", 6) == 0) { + if (sym == NULL && dependent && strncmp (lbl, "__imp_", 6) == 0) { sym = GetProcAddress(instance, lbl + 6); if (sym != NULL) { @@ -1214,12 +1329,6 @@ lookupSymbolInDLL_PEi386 ( const SymbolName* lbl, HINSTANCE instance, pathchar* } } - sym = GetProcAddress(instance, lbl); - if (sym != NULL) { - /*debugBelch("found %s in %s\n", lbl,dll_name);*/ - return sym; - } - return NULL; } @@ -1821,6 +1930,27 @@ ocGetNames_PEi386 ( ObjectCode* oc ) } if(NULL != targetSection) addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); + else + { + // Do the symbol lookup based on name, this follows Microsoft's weak external's + // format 3 specifications. Example header generated: + // api-ms-win-crt-stdio-l1-1-0.dll: file format pe-x86-64 + // + // SYMBOL TABLE: + // [ 0](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @comp.id + // [ 1](sec -1)(fl 0x00)(ty 0)(scl 3) (nx 0) 0x0000000000000000 @feat.00 + // [ 2](sec 0)(fl 0x00)(ty 0)(scl 2) (nx 0) 0x0000000000000000 _write + // [ 3](sec 0)(fl 0x00)(ty 0)(scl 105) (nx 1) 0x0000000000000000 write + // AUX lnno 3 size 0x0 tagndx 2 + // + // https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#auxiliary-f… + SymbolName *target_sname = get_sym_name (getSymShortName (info, targetSym), oc); + if (target_sname) + addr = lookupSymbol_PEi386 (target_sname, oc, &type); + + IF_DEBUG(linker, debugBelch("weak external symbol @ %s => %s resolved to %p\n", \ + sname, target_sname, addr)); + } } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { /* This symbol isn't in any section at all, ie, global bss. @@ -2115,6 +2245,13 @@ ocResolve_PEi386 ( ObjectCode* oc ) *(uint64_t *)pP = S + A; break; } + case 11: /* IMAGE_REL_AMD64_SECREL (PE constant 11) */ + { + uint64_t offset = S - (uint64_t) section.start; + CHECK((uint32_t) offset == offset); + *(uint32_t *)pP = offset + A; + break; + } case 2: /* R_X86_64_32 (ELF constant 10) - IMAGE_REL_AMD64_ADDR32 (PE constant 2) */ case 3: /* IMAGE_REL_AMD64_ADDR32NB (PE constant 3) */ case 17: /* R_X86_64_32S ELF constant, no PE mapping. See note [ELF constant in PE file] */ ===================================== testsuite/tests/driver/recomp015/all.T ===================================== @@ -5,7 +5,11 @@ test('recomp015', # See ticket:11022#comment:7 unless(opsys('linux') or opsys('solaris2') or opsys('openbsd'), skip), when(arch('arm'), skip), - js_skip # JS backend doesn't support .s assembly files + js_skip, # JS backend doesn't support .s assembly files + + # the linker sometimes throws warnings since we don't + # generate a .note.GNU-stack section + ignore_stderr, ], makefile_test, []) ===================================== testsuite/tests/rts/all.T ===================================== @@ -426,9 +426,7 @@ test('T10296b', [only_ways(['threaded2'])], compile_and_run, ['']) test('numa001', [ extra_run_opts('8'), unless(unregisterised(), extra_ways(['debug_numa'])), req_ghc_with_threaded_rts ] , compile_and_run, ['']) -test('T12497', [ unless(opsys('mingw32'), skip), expect_broken(22694) - ], - makefile_test, ['T12497']) +test('T12497', unless(opsys('mingw32'), skip), makefile_test, ['T12497']) test('T13617', [ unless(opsys('mingw32'), skip)], makefile_test, ['T13617']) ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-32-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line ===================================== testsuite/tests/rts/linker/T11223/T11223_link_order_a_b_2_fail.stderr-ws-64-mingw32 ===================================== @@ -3,7 +3,7 @@ GHC runtime linker: fatal error: I found a duplicate definition for symbol whilst processing object file E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libfoo_link_lib_3.a The symbol was previously defined in - E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#2:bar_link_lib_3.o) + E:\ghc-dev\msys64\home\Tamar\ghc\testsuite\tests\rts\T11223\T11223_link_order_a_b_2_fail.run\libbar_link_lib_3.a(#3:bar_link_lib_3.o) This could be caused by: * Loading two different object files which export the same symbol * Specifying the same object file twice on the GHCi command line ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -91,7 +91,7 @@ findLinkFlags enableOverride cc ccLink -- executable exists before trying cc. do _ <- findProgram (linker ++ " linker") emptyProgOpt ["ld."++linker] prog <$ checkLinkWorks cc prog - | linker <- ["lld", "gold", "bfd"] + | linker <- ["lld", "bfd"] , let prog = over _prgFlags (++["-fuse-ld="++linker]) ccLink ] <|> (ccLink <$ checkLinkWorks cc ccLink) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86943ca2569120f5bdcdf259d83d5e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86943ca2569120f5bdcdf259d83d5e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-upload-libs] gitlab-ci: Split up hackage-doc-tarball job into two
by Ben Gamari (＠bgamari) 16 Jul '25

16 Jul '25

Ben Gamari pushed to branch wip/fix-upload-libs at Glasgow Haskell Compiler / GHC Commits: 2625dd53 by Ben Gamari at 2025-07-16T00:00:02-04:00 gitlab-ci: Split up hackage-doc-tarball job into two One for the nightly pipeline and another for the release pipeline. This both improves the naming and makes the dependency structure more explicit. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -605,7 +605,7 @@ doc-tarball: - mv docs/*.tar.xz docs/*.pdf . - ls -lh -hackage-doc-tarball: +.hackage-doc-tarball: stage: packaging needs: - job: nightly-x86_64-linux-fedora33-release-hackage @@ -635,8 +635,21 @@ hackage-doc-tarball: - . .gitlab/ci.sh configure - ./upload_ghc_libs.py prepare --bindist ghc*linux/ - mv .upload-libs/docs ../hackage_docs + +nightly-hackage-doc-tarball: + extends: .hackage-doc-tarball + needs: + - job: nightly-x86_64-linux-fedora33-release-hackage + - job: source-tarball rules: - if: $NIGHTLY + +release-hackage-doc-tarball: + extends: .hackage-doc-tarball + needs: + - job: release-x86_64-linux-fedora33-release-hackage + - job: source-tarball + rules: - if: '$RELEASE_JOB == "yes"' source-tarball: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2625dd53113a5e9ad384e12fa5dc3e0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2625dd53113a5e9ad384e12fa5dc3e0… You're receiving this email because of your account on gitlab.haskell.org.

1 0