- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/post-string-len-assertion] Fix assertion in `postStringLen` to account for \0 byte
by Hannes Siebenhandl (＠fendor) 30 Oct '25

30 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/post-string-len-assertion at Glasgow Haskell Compiler / GHC Commits: 50a62b35 by fendor at 2025-10-30T13:16:32+01:00 Fix assertion in `postStringLen` to account for \0 byte We fix the assertion to handle trailing \0 bytes in `postStringLen`. Before this change, the assertion looked like this: ASSERT(eb->begin + eb->size > eb->pos + len + 1); Let's assume some values to see why this is actually off by one: eb->begin = 0 eb->size = 1 eb->pos = 0 len = 1 then the assertion would trigger correctly: 0 + 1 > 0 + 1 + 1 => 1 > 2 => false as there is not enough space for the \0 byte (which is the trailing +1). However, if we change `eb->size = 2`, then we do have enough space for a string of length 1, but the assertion still fails: 0 + 2 > 0 + 1 + 1 => 2 > 2 => false Which causes the assertion to fail if there is exactly enough space for the string with a trailing \0 byte. Clearly, the assertion should be `>=`! If we switch around the operand, it should become more obvious that `<=` is the correct comparison: ASSERT(eb->pos + len + 1 <= eb->begin + eb->size); This is expresses more naturally that the current position plus the length of the string (and the null byte) must be smaller or equal to the overall size of the buffer. This change also is in line with the implementation in `hasRoomForEvent` and `hasRoomForVariableEvent`: ``` StgBool hasRoomForEvent(EventsBuf *eb, EventTypeNum eNum) { uint32_t size = ...; if (eb->pos + size > eb->begin + eb->size) ... ``` the check `eb->pos + size > eb->begin + eb->size` is identical to `eb->pos + size <= eb->begin + eb->size` plus a negation. - - - - - 1 changed file: - rts/eventlog/EventLog.c Changes: ===================================== rts/eventlog/EventLog.c ===================================== @@ -197,7 +197,7 @@ static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) static inline void postStringLen(EventsBuf *eb, const char *buf, StgWord len) { if (buf) { - ASSERT(eb->begin + eb->size > eb->pos + len + 1); + ASSERT(eb->pos + len + 1 <= eb->begin + eb->size); memcpy(eb->pos, buf, len); eb->pos += len; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50a62b35af5de5564d60c9b28a1536e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50a62b35af5de5564d60c9b28a1536e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fendor/post-string-len-assertion
by Hannes Siebenhandl (＠fendor) 30 Oct '25

30 Oct '25

Hannes Siebenhandl pushed new branch wip/fendor/post-string-len-assertion at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fendor/post-string-len-assert… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/dodgy-hidden-components] Supplant TcRnExportHiddenComponents with TcRnDodgyExports (#26534)
by Vladislav Zavialov (＠int-index) 30 Oct '25

30 Oct '25

Vladislav Zavialov pushed to branch wip/int-index/dodgy-hidden-components at Glasgow Haskell Compiler / GHC Commits: 2a425efa by Vladislav Zavialov at 2025-10-30T14:07:52+03:00 Supplant TcRnExportHiddenComponents with TcRnDodgyExports (#26534) Remove a bogus special case in lookup_ie_kids_all, making TcRnExportHiddenComponents obsolete. - - - - - 10 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/diagnostic-codes/codes.stdout - + testsuite/tests/warnings/should_compile/DodgyExports02.hs - + testsuite/tests/warnings/should_compile/DodgyExports02.stderr - + testsuite/tests/warnings/should_compile/DodgyExports03.hs - + testsuite/tests/warnings/should_compile/DodgyExports03.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -636,11 +636,6 @@ instance Diagnostic TcRnMessage where $ formatExportItemError (text "module" <+> ppr mod) "is missing an export list" - TcRnExportHiddenComponents export_item - -> mkSimpleDecorated - $ formatExportItemError - (ppr export_item) - "attempts to export constructors or class methods that are not visible here" TcRnExportHiddenDefault export_item -> mkSimpleDecorated $ formatExportItemError @@ -2194,8 +2189,6 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnDodgyExports TcRnMissingExportList{} -> WarningWithFlag Opt_WarnMissingExportList - TcRnExportHiddenComponents{} - -> ErrorWithoutFlag TcRnExportHiddenDefault{} -> ErrorWithoutFlag TcRnDuplicateExport{} @@ -2865,8 +2858,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnMissingExportList{} -> noHints - TcRnExportHiddenComponents{} - -> noHints TcRnExportHiddenDefault{} -> noHints TcRnDuplicateExport{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1606,15 +1606,6 @@ data TcRnMessage where -} TcRnMissingExportList :: ModuleName -> TcRnMessage - {-| TcRnExportHiddenComponents is an error that occurs when an export contains - constructor or class methods that are not visible. - - Example(s): None - - Test cases: None - -} - TcRnExportHiddenComponents :: IE GhcPs -> TcRnMessage - {-| TcRnExportHiddenDefault is an error that occurs when an export contains a class default (with language extension NamedDefaults) that is not visible. ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -525,7 +525,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod } (L loc ie@(IEThingAll (warn_txt_ps, ann) l doc)) = do mb_gre <- lookupGreAvailRn (ieLWrappedNameWhatLooking l) $ lieWrappedName l for mb_gre $ \ par -> do - all_kids <- lookup_ie_kids_all ie l par + all_kids <- lookup_ie_kids_all l par let name = greName par all_gres = par : all_kids all_names = map greName all_gres @@ -561,7 +561,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod wc_kids <- case wc of NoIEWildcard -> return [] - IEWildcard _ -> lookup_ie_kids_all ie l par + IEWildcard _ -> lookup_ie_kids_all l par let name = greName par all_kids = with_kids ++ wc_kids @@ -593,20 +593,15 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod do { kids <- lookupChildrenExport gre sub_rdrs ; return (map fst kids, map snd kids) } - lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt + lookup_ie_kids_all :: LIEWrappedName GhcPs -> GlobalRdrElt -> RnM [GlobalRdrElt] - lookup_ie_kids_all ie (L _loc rdr) gre = + lookup_ie_kids_all (L _loc rdr) gre = do { let name = greName gre gres = findChildren kids_env name -- We only choose level 0 exports when filling in part of an export list implicitly. ; let kids_0 = mapMaybe pickLevelZeroGRE gres ; addUsedKids (ieWrappedName rdr) kids_0 - ; when (null kids_0) $ - if isTyConName name - then addTcRnDiagnostic (TcRnDodgyExports gre) - else -- This occurs when you export T(..), but - -- only import T abstractly, or T is a synonym. - addErr (TcRnExportHiddenComponents ie) + ; when (null kids_0) $ addTcRnDiagnostic (TcRnDodgyExports gre) ; return kids_0 } ------------- ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -505,7 +505,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnExportedModNotImported" = 90973 GhcDiagnosticCode "TcRnNullExportedModule" = 64649 GhcDiagnosticCode "TcRnMissingExportList" = 85401 - GhcDiagnosticCode "TcRnExportHiddenComponents" = 94558 + GhcDiagnosticCode "TcRnExportHiddenComponents" = Outdated 94558 GhcDiagnosticCode "TcRnExportHiddenDefault" = 74775 GhcDiagnosticCode "TcRnDuplicateExport" = 47854 GhcDiagnosticCode "TcRnDuplicateNamedDefaultExport" = 31584 ===================================== testsuite/tests/diagnostic-codes/codes.stdout ===================================== @@ -52,7 +52,6 @@ [GHC-55868] is untested (constructor = TcRnArrowIfThenElsePredDependsOnResultTy) [GHC-51876] is untested (constructor = TcRnDupeModuleExport) [GHC-64649] is untested (constructor = TcRnNullExportedModule) -[GHC-94558] is untested (constructor = TcRnExportHiddenComponents) [GHC-63055] is untested (constructor = TcRnFieldUpdateInvalidType) [GHC-26133] is untested (constructor = TcRnForeignImportPrimSafeAnn) [GHC-03355] is untested (constructor = TcRnIllegalForeignDeclBackend) ===================================== testsuite/tests/warnings/should_compile/DodgyExports02.hs ===================================== @@ -0,0 +1,7 @@ +module DodgyExports02 + ( Identity(..) -- type constructor has out-of-scope children + , Void(..) -- type constructor has no children + ) where + +import Data.Void (Void) +import Data.Functor.Identity (Identity) ===================================== testsuite/tests/warnings/should_compile/DodgyExports02.stderr ===================================== @@ -0,0 +1,10 @@ +DodgyExports02.hs:2:5: warning: [GHC-75356] [-Wdodgy-exports (in -Wextra)] + The export item ‘Identity(..)’ suggests that + ‘Identity’ has (in-scope) constructors or record fields, + but it has none + +DodgyExports02.hs:3:5: warning: [GHC-75356] [-Wdodgy-exports (in -Wextra)] + The export item ‘Void(..)’ suggests that + ‘Void’ has (in-scope) constructors or record fields, + but it has none + ===================================== testsuite/tests/warnings/should_compile/DodgyExports03.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExplicitNamespaces #-} + +module DodgyExports03 + ( data MkR(..) -- data constructors never have children ('fld' belongs to 'R') + ) where + +data R = MkR { fld :: Int } ===================================== testsuite/tests/warnings/should_compile/DodgyExports03.stderr ===================================== @@ -0,0 +1,4 @@ +DodgyExports03.hs:4:5: warning: [GHC-75356] [-Wdodgy-exports (in -Wextra)] + The export item ‘MkR(..)’ suggests that + ‘MkR’ has children, but it is not a type constructor or a class + ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -54,6 +54,8 @@ test('T19564d', normal, compile, ['']) # Also, suppress uniques as one of the warnings is unstable in CI, otherwise. test('T19296', normal, compile, ['-fdiagnostics-show-caret -Wredundant-constraints -dsuppress-uniques']) test('DodgyExports01', normal, compile, ['-Wdodgy-exports']) +test('DodgyExports02', normal, compile, ['-Wdodgy-exports']) +test('DodgyExports03', normal, compile, ['-Wdodgy-exports']) test('DerivingTypeable', normal, compile, ['-Wderiving-typeable']) test('T18862a', normal, compile, ['']) test('T18862b', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a425efaf3d622a8c776cac7813cb55… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a425efaf3d622a8c776cac7813cb55… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-sample-profiler] Sample Profiler commit
by Hannes Siebenhandl (＠fendor) 30 Oct '25

30 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-sample-profiler at Glasgow Haskell Compiler / GHC Commits: fe1b7b91 by fendor at 2025-10-30T10:19:24+01:00 Sample Profiler commit - - - - - 7 changed files: - .gitmodules - + eventlog-live-profiling-prototype - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "eventlog-live-profiling-prototype"] + path = eventlog-live-profiling-prototype + url = git@gitlab.well-typed.com:well-typed/eventlog-live-profiling-prototype.git ===================================== eventlog-live-profiling-prototype ===================================== @@ -0,0 +1 @@ +Subproject commit db767230707a50f206ec446e63b7de6bca92dcf0 ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import Sampler +#endif + +runWithSampleProfiler :: IO () -> IO () +runWithSampleProfiler = +#if defined(SAMPLE_TRACER) + withSampleProfiler 10000 {- Every 10 ms -} +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithSampleProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-sampler-eventlog + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_sampler_eventlog, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,8 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_sampler_eventlog + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +137,7 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_sampler_eventlog = lib "ghc-sampler-eventlog" `setPath` "eventlog-live-profiling-prototype/sampler" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,7 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_sampler_eventlog ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_sampler_eventlog ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe1b7b91ab91a61aaa43d361f16a505… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe1b7b91ab91a61aaa43d361f16a505… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: remove unneccesary cabal flags
by Marge Bot (＠marge-bot) 30 Oct '25

30 Oct '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 643ce801 by Julian Ospald at 2025-10-28T18:18:55-04:00 rts: remove unneccesary cabal flags We perform those checks via proper autoconf macros instead that do the right thing and then add those libs to the rts buildinfo. - - - - - d69ea8fe by Vladislav Zavialov at 2025-10-28T18:19:37-04:00 Test case for #17705 Starting with GHC 9.12 (the first release to include 5745dbd3), all examples in this ticket are handled as expected. - - - - - 1c13c171 by Andreas Klebinger at 2025-10-30T04:58:28-04:00 Add a perf test for #26425 - - - - - 6044b81e by Andreas Klebinger at 2025-10-30T04:58:28-04:00 OccAnal: Be stricter for better compiler perf. In particular we are now stricter: * When combining usageDetails. * When computing binder info. In combineUsageDetails when combining the underlying adds we compute a new `LocalOcc` for each entry by combining the two existing ones. Rather than wait for those entries to be forced down the road we now force them immediately. Speeding up T26425 by about 10% with little effect on the common case. We also force binders we put into the Core AST everywhere now. Failure to do so risks leaking the occ env used to set the binders OccInfo. For T26425 compiler residency went down by a factor of ~10x. Compile time also improved by a factor of ~1.6. ------------------------- Metric Decrease: T18698a T26425 T9233 ------------------------- - - - - - 46bf1b58 by Vladislav Zavialov at 2025-10-30T04:58:29-04:00 Fix namespace specifiers in subordinate exports (#12488) This patch fixes an oversight in the `lookupChildrenExport` function that caused explicit namespace specifiers of subordinate export items to be ignored: module M (T (type A)) where -- should be rejected data T = A Based on the `IEWrappedName` data type, there are 5 cases to consider: 1. Unadorned name: P(X) 2. Named default: P(default X) 3. Pattern synonym: P(pattern X) 4. Type name: P(type X) 5. Data name: P(data X) Case 1 is already handled correctly; cases 2 and 3 are parse errors; and it is cases 4 and 5 that we are concerned with in this patch. Following the precedent established in `LookupExactName`, we introduce a boolean flag in `LookupChildren` to control whether to look up in all namespaces or in a specific one. If an export item is accompanied by an explicit namespace specifier `type` or `data`, we restrict the lookup in `lookupGRE` to a specific namespace. The newly introduced diagnostic `TcRnExportedSubordinateNotFound` provides error messages and suggestions more tailored to this context than the previously used `reportUnboundName`. - - - - - 39 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Var/Env.hs - m4/fp_check_pthreads.m4 - rts/configure.ac - + rts/rts.buildinfo.in - rts/rts.cabal - testsuite/tests/module/mod4.stderr - + testsuite/tests/parser/should_fail/T12488c.hs - + testsuite/tests/parser/should_fail/T12488c.stderr - + testsuite/tests/parser/should_fail/T12488d.hs - + testsuite/tests/parser/should_fail/T12488d.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/perf/compiler/T26425.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/rename/should_compile/T12488b.hs - + testsuite/tests/rename/should_compile/T12488f.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T12488a.hs - + testsuite/tests/rename/should_fail/T12488a.stderr - + testsuite/tests/rename/should_fail/T12488a_foo.hs - + testsuite/tests/rename/should_fail/T12488a_foo.stderr - + testsuite/tests/rename/should_fail/T12488e.hs - + testsuite/tests/rename/should_fail/T12488e.stderr - + testsuite/tests/rename/should_fail/T12488g.hs - + testsuite/tests/rename/should_fail/T12488g.stderr - testsuite/tests/rename/should_fail/T25899e2.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_compile/T17705.hs - testsuite/tests/typecheck/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02009f802e02507b626f33449a5b61… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02009f802e02507b626f33449a5b61… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/ghc-sample-profiler] 2 commits: Expose more stack decoding details
by Hannes Siebenhandl (＠fendor) 30 Oct '25

30 Oct '25

Hannes Siebenhandl pushed to branch wip/fendor/ghc-sample-profiler at Glasgow Haskell Compiler / GHC Commits: 3ff55063 by fendor at 2025-10-29T15:51:02+01:00 Expose more stack decoding details - - - - - 7d53eed9 by fendor at 2025-10-29T16:13:07+01:00 Sample Profiler commit - - - - - 10 changed files: - .gitmodules - + eventlog-live-profiling-prototype - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghci/GHCi/Message.hs Changes: ===================================== .gitmodules ===================================== @@ -124,3 +124,6 @@ [submodule "libraries/template-haskell-quasiquoter"] path = libraries/template-haskell-quasiquoter url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git +[submodule "eventlog-live-profiling-prototype"] + path = eventlog-live-profiling-prototype + url = git@gitlab.well-typed.com:well-typed/eventlog-live-profiling-prototype.git ===================================== eventlog-live-profiling-prototype ===================================== @@ -0,0 +1 @@ +Subproject commit 4ebbfbfffd3dd255a661414b5d7c9a990ff4f4fc ===================================== ghc/Main.hs ===================================== @@ -80,6 +80,7 @@ import GHC.Iface.Errors.Ppr import GHC.Driver.Session.Mode import GHC.Driver.Session.Lint import GHC.Driver.Session.Units +import GHC.Driver.Monad -- Standard Haskell libraries import System.IO @@ -91,6 +92,17 @@ import Control.Monad.Trans.Except (throwE, runExceptT) import Data.List ( isPrefixOf, partition, intercalate ) import Prelude import qualified Data.List.NonEmpty as NE +#if defined(SAMPLE_TRACER) +import Sampler +#endif + +runWithSampleProfiler :: IO () -> IO () +runWithSampleProfiler = +#if defined(SAMPLE_TRACER) + withSampleProfiler 10000 {- Every 10 ms -} +#else + id +#endif ----------------------------------------------------------------------------- -- ToDo: @@ -153,7 +165,8 @@ main = do ShowGhciUsage -> showGhciUsage dflags PrintWithDynFlags f -> putStrLn (f dflags) Right postLoadMode -> - main' postLoadMode units dflags argv3 flagWarnings + reifyGhc $ \session -> runWithSampleProfiler $ + reflectGhc (main' postLoadMode units dflags argv3 flagWarnings) session main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn] -> Ghc () ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -27,6 +27,11 @@ Flag threaded Default: True Manual: True +Flag sampleTracer + Description: Whether we instrument the ghc binary with sample tracer when the eventlog is enabled + Default: False + Manual: True + Executable ghc Default-Language: GHC2021 @@ -45,6 +50,10 @@ Executable ghc ghc-boot == @ProjectVersionMunged@, ghc == @ProjectVersionMunged@ + if flag(sampleTracer) + build-depends: ghc-sampler-eventlog + CPP-OPTIONS: -DSAMPLE_TRACER + if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 else ===================================== hadrian/src/Packages.hs ===================================== @@ -13,6 +13,7 @@ module Packages ( transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, + ghc_sampler_eventlog, -- * Package information crossPrefix, programName, nonHsMainPackage, programPath, timeoutPath, @@ -43,7 +44,8 @@ ghcPackages = , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio , timeout , lintersCommon - , lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] + , ghc_sampler_eventlog + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -135,6 +137,7 @@ unlit = util "unlit" unix = lib "unix" win32 = lib "Win32" xhtml = lib "xhtml" +ghc_sampler_eventlog = lib "ghc-sampler-eventlog" `setPath` "eventlog-live-profiling-prototype/sampler" lintersCommon = lib "linters-common" `setPath` "linters/linters-common" lintNotes = linter "lint-notes" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -180,6 +180,7 @@ stage1Packages = do , unlit , xhtml , if winTarget then win32 else unix + , ghc_sampler_eventlog ] , when (not cross) [ hpcBin ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -108,6 +108,12 @@ packageArgs = do , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc_sampler_eventlog ? mconcat + [ builder (Cabal Flags) ? mconcat + [ arg "-use-ghc-trace-events" + ] + ] + ---------------------------------- ghc --------------------------------- , package ghc ? mconcat [ builder Ghc ? mconcat ===================================== libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc ===================================== @@ -15,12 +15,13 @@ module GHC.Internal.InfoProv.Types , getIPE , StgInfoTable , lookupIPE + , lookupIpProvId ) where import GHC.Internal.Base import GHC.Internal.Enum import GHC.Internal.Real (fromIntegral) -import GHC.Internal.Word (Word32) +import GHC.Internal.Word (Word32, Word64) import GHC.Internal.Show (Show) import GHC.Internal.Ptr (Ptr(..), plusPtr) import GHC.Internal.Foreign.C.String.Encoding (CString, peekCString) @@ -32,6 +33,7 @@ import GHC.Internal.ClosureTypes import GHC.Internal.Prim (whereFrom##) data InfoProv = InfoProv { + ipProvId :: Word64, ipName :: String, ipDesc :: ClosureType, ipTyDesc :: String, @@ -59,6 +61,13 @@ lookupIPE itbl = allocaBytes (#size InfoProvEnt) $ \p -> do 1 -> Just `fmap` peekInfoProv (ipeProv p) _ -> return Nothing +lookupIpProvId :: Ptr StgInfoTable -> IO (Maybe Word64) +lookupIpProvId itbl = allocaBytes (#size InfoProvEnt) $ \p -> do + res <- c_lookupIPE itbl p + case res of + 1 -> Just `fmap` peekIpProvId (ipeProv p) + _ -> return Nothing + getIPE :: a -> r -> (Ptr InfoProvEnt -> IO r) -> IO r getIPE obj fail k = allocaBytes (#size InfoProvEnt) $ \p -> IO $ \s -> case whereFrom## obj (unPtr p) s of @@ -73,6 +82,9 @@ ipeProv p = (#ptr InfoProvEnt, prov) p peekIpDesc :: Ptr InfoProv -> IO Word32 peekIpDesc p = (# peek InfoProv, closure_desc) p +peekIpProvId :: Ptr InfoProv -> IO Word64 +peekIpProvId p = (# peek InfoProv, info_prov_id) p + peekIpName, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString peekIpName p = (# peek InfoProv, table_name) p peekIpLabel p = (# peek InfoProv, label) p @@ -84,6 +96,7 @@ peekIpTyDesc p = (# peek InfoProv, ty_desc) p peekInfoProv :: Ptr InfoProv -> IO InfoProv peekInfoProv infop = do + provId <- peekIpProvId infop name <- peekCString utf8 =<< peekIpName infop desc <- peekIpDesc infop tyDesc <- peekCString utf8 =<< peekIpTyDesc infop @@ -93,6 +106,7 @@ peekInfoProv infop = do file <- peekCString utf8 =<< peekIpSrcFile infop span <- peekCString utf8 =<< peekIpSrcSpan infop return InfoProv { + ipProvId = provId, ipName = name, -- The INVALID_OBJECT case should be impossible as we -- control the C code generating these values. ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -25,6 +25,10 @@ module GHC.Internal.Stack.Decode ( -- * Pretty printing prettyStackEntry, prettyStackFrameWithIpe, + -- * Low level decoding functions + StackFrameLocation(..), + unpackStackFrameTo, + getStackFields, ) where @@ -69,6 +73,7 @@ import GHC.Internal.Stack.ConstantsProf () #endif import GHC.Internal.Stack.CloneStack import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE) +import qualified GHC.Internal.InfoProv.Types as IPE {- Note [Decoding the stack] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -186,11 +191,11 @@ foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSna -- | Get the 'StgInfoTable' of the stack frame. -- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any. -getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv) +getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Ptr IPE.StgInfoTable) getInfoTableOnStack stackSnapshot# index = let !(# itbl_struct#, itbl_ptr_ipe_key# #) = getInfoTableAddrs# stackSnapshot# (wordOffsetToWord# index) in - (,) <$> peekItbl (Ptr itbl_struct#) <*> lookupIPE (Ptr itbl_ptr_ipe_key#) + (,) <$> peekItbl (Ptr itbl_struct#) <*> pure (Ptr itbl_ptr_ipe_key#) getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable getInfoTableForStack stackSnapshot# = @@ -324,8 +329,9 @@ unpackStackFrame stackFrameLoc = do unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)] unpackStackFrameWithIpe stackFrameLoc = do unpackStackFrameTo stackFrameLoc - (\ info mIpe nextChunk@(StackSnapshot stack#) -> do + (\ info infoKey nextChunk@(StackSnapshot stack#) -> do framesWithIpe <- decodeStackWithIpe nextChunk + mIpe <- lookupIPE infoKey pure [ ( UnderflowFrame { info_tbl = info, @@ -340,22 +346,26 @@ unpackStackFrameWithIpe stackFrameLoc = do ) ] ) - (\ frame mIpe -> pure [(frame, mIpe)]) + (\ frame infoKey -> do + mIpe <- lookupIPE infoKey + pure [(frame, mIpe)]) unpackStackFrameTo :: forall a . StackFrameLocation -> -- ^ Decode the given 'StackFrame'. - (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a) -> + (StgInfoTable -> Ptr IPE.StgInfoTable -> StackSnapshot -> IO a) -> -- ^ How to handle 'UNDERFLOW_FRAME's. - (StackFrame -> Maybe InfoProv -> IO a) -> + -- The pointer is the key for the 'lookupIPE'. + (StackFrame -> Ptr IPE.StgInfoTable -> IO a) -> -- ^ How to handle all other 'StackFrame' values. + -- The pointer is the key for the 'lookupIPE'. IO a unpackStackFrameTo (StackSnapshot stackSnapshot#, index) unpackUnderflowFrame finaliseStackFrame = do - (info, m_info_prov) <- getInfoTableOnStack stackSnapshot# index + (info, infoTablePtr) <- getInfoTableOnStack stackSnapshot# index unpackStackFrame' info - (unpackUnderflowFrame info m_info_prov) - (`finaliseStackFrame` m_info_prov) + (unpackUnderflowFrame info infoTablePtr) + (`finaliseStackFrame` infoTablePtr) where unpackStackFrame' :: StgInfoTable -> ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -545,7 +545,11 @@ instance Binary Heap.ClosureType instance Binary Heap.PrimType instance Binary a => Binary (Heap.GenClosure a) instance Binary InfoProv where -#if MIN_VERSION_base(4,20,0) +#if MIN_VERSION_base(4,22,0) + get = InfoProv <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get + put (InfoProv x1 x2 x3 x4 x5 x6 x7 x8 x9) + = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8 >> put x9 +#elif MIN_VERSION_base(4,20,0) get = InfoProv <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get put (InfoProv x1 x2 x3 x4 x5 x6 x7 x8) = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf56eb3f0e03291e86b71f6979e87… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf56eb3f0e03291e86b71f6979e87… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/torsten.schmits/mercury-ghc910-mhu-transitive-th-deps
by Torsten Schmits (＠torsten.schmits) 30 Oct '25

30 Oct '25

Torsten Schmits pushed new branch wip/torsten.schmits/mercury-ghc910-mhu-transitive-th-deps at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/mercury-ghc91… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/torsten.schmits/mercury-mhu-transitive-th-deps] WIP: transitive TH deps with MHU
by Torsten Schmits (＠torsten.schmits) 29 Oct '25

29 Oct '25

Torsten Schmits pushed to branch wip/torsten.schmits/mercury-mhu-transitive-th-deps at Glasgow Haskell Compiler / GHC Commits: 8323b4b9 by Torsten Schmits at 2025-10-29T23:37:12+01:00 WIP: transitive TH deps with MHU - - - - - 14 changed files: - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - testsuite/tests/bytecode/T25090/all.T - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepA/A.hs - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepC/C.hs - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/Makefile - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/all.T - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/Dep1.hs - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/dep1.conf - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-bc.stdout - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-obj.stdout - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unita - + testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unitc Changes: ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Linker.Deps ( LinkDepsOpts (..) , LinkDeps (..) + , LibraryUnits (..) , getLinkDeps ) where @@ -84,10 +85,16 @@ data LinkDepsOpts = LinkDepsOpts data LinkDeps = LinkDeps { ldNeededLinkables :: [Linkable] , ldAllLinkables :: [Linkable] - , ldNeededUnits :: [UnitId] + , ldNeededUnits :: [LibraryUnits] , ldAllUnits :: UniqDSet UnitId } +data LibraryUnits + = LibraryUnits + { home_unit :: !UnitId + , library_unit :: !UnitId + } + -- | Find all the packages and linkables that a set of modules depends on -- -- Return the module and package dependencies for the needed modules. @@ -142,6 +149,7 @@ instance Outputable LinkExternalDetails where data LinkExternal = LinkExternal { le_details :: LinkExternalDetails, + le_unit_for_dbs :: !UnitId, le_module :: !Module } @@ -215,7 +223,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do -- entire set for oneshot mode. separate_home_deps = if ldOneShotMode opts - then pure ([], LinkExternal LinkAllDeps <$!> noninteractive) + then pure ([], LinkExternal LinkAllDeps (ue_currentUnit unit_env) <$!> noninteractive) else make_deps make_deps = do @@ -239,7 +247,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do Nothing -> let (ModNodeKeyWithUid (GWIB mod_name _) uid) = nk mod = Module (RealUnit (Definite uid)) mod_name - in make_deps_loop (LinkExternal LinkAllDeps mod : external, found_mods) nexts + in make_deps_loop (LinkExternal LinkAllDeps (ue_currentUnit unit_env) mod : external, found_mods) nexts Just trans_deps -> let deps = Set.insert (NodeKey_Module nk) (Set.fromList trans_deps) -- See #936 and the ghci.prog007 test for why we have to continue traversing through @@ -256,7 +264,8 @@ get_link_deps opts pls maybe_normal_osuf span mods = do case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of Just hmi -> do let iface = hm_iface hmi - pure (LinkExternal (LinkOnlyPackages iface) (mi_module iface), hmi) + mod = mi_module iface + pure (LinkExternal (LinkOnlyPackages iface) (moduleUnitId mod) mod, hmi) Nothing -> throwProgramError opts $ text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid @@ -319,12 +328,13 @@ get_link_deps opts pls maybe_normal_osuf span mods = do data LinkDep = LinkModules !(UniqDFM ModuleName LinkModule) | - LinkLibrary !UnitId + LinkLibrary !LibraryUnits instance Outputable LinkDep where ppr = \case LinkModules mods -> text "modules:" <+> ppr (eltsUDFM mods) - LinkLibrary uid -> text "library:" <+> ppr uid + LinkLibrary (LibraryUnits {home_unit, library_unit}) -> + text "library:" <+> ppr library_unit <+> parens (ppr home_unit) data OneshotError = NoInterface !MissingInterfaceError @@ -397,7 +407,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do already_seen | Just (LinkModules mods) <- mod_dep = elemUDFM mod_name mods - | Just (LinkLibrary _) <- mod_dep + | Just (LinkLibrary {}) <- mod_dep = True | otherwise = False @@ -429,7 +439,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do = add_library add_library = - pure (addToUDFM acc mod_unit_id (LinkLibrary mod_unit_id), [], Just "library") + pure (addToUDFM acc mod_unit_id (LinkLibrary (LibraryUnits {home_unit = le_unit_for_dbs, library_unit = mod_unit_id})), [], Just "library") add_module iface lmod action = with_deps with_mod iface True action @@ -437,7 +447,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do with_mod = alterUDFM (add_package_module lmod) acc mod_unit_id add_package_module lmod = \case - Just (LinkLibrary u) -> Just (LinkLibrary u) + Just (LinkLibrary lib) -> Just (LinkLibrary lib) Just (LinkModules old) -> Just (LinkModules (addToUDFM old mod_name lmod)) Nothing -> Just (LinkModules (unitUDFM mod_name lmod)) @@ -449,7 +459,7 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do local_deps iface = [ - LinkExternal LinkAllDeps (mkModule mod_unit m) + LinkExternal LinkAllDeps le_unit_for_dbs (mkModule mod_unit m) | (_, GWIB m _) <- Set.toList (dep_direct_mods (mi_deps iface)) ] @@ -458,9 +468,9 @@ external_deps_loop opts (job@LinkExternal {le_module = mod, ..} : mods) acc = do -- Otherwise, link all package deps as libraries. package_deps iface | package_bc - = ([], [LinkExternal LinkAllDeps usg_mod | UsagePackageModule {usg_mod} <- mi_usages iface]) + = ([], [LinkExternal LinkAllDeps le_unit_for_dbs usg_mod | UsagePackageModule {usg_mod} <- mi_usages iface]) | otherwise - = ([(u, LinkLibrary u) | u <- Set.toList (dep_direct_pkgs (mi_deps iface))], []) + = ([(u, LinkLibrary (LibraryUnits {home_unit = le_unit_for_dbs, library_unit = u})) | u <- Set.toList (dep_direct_pkgs (mi_deps iface))], []) load_reason = text "need to link module" <+> ppr mod <+> @@ -500,7 +510,7 @@ classify_deps :: LoaderState -> [HomeModInfo] -> [LinkDep] -> - ([Linkable], [LinkModule], UniqDSet UnitId, [UnitId]) + ([Linkable], [LinkModule], UniqDSet UnitId, [LibraryUnits]) classify_deps pls hmis deps = (loaded_modules' ++ loaded_modules'', needed_modules' ++ needed_modules'', all_packages, needed_packages) where @@ -509,11 +519,13 @@ classify_deps pls hmis deps = partitionWith loaded_or_needed_module (concatMap eltsUDFM modules) needed_packages = - eltsUDFM (getUniqDSet all_packages `minusUDFM` pkgs_loaded pls) + eltsUDFM (packages `minusUDFM` pkgs_loaded pls) + + packages = listToUDFM [(library_unit p, p) | p <- packages_with_home_units] - all_packages = mkUniqDSet packages + all_packages = mkUniqDSet (map library_unit packages_with_home_units) - (modules, packages) = flip partitionWith deps $ \case + (modules, packages_with_home_units) = flip partitionWith deps $ \case LinkModules mods -> Left mods LinkLibrary lib -> Right lib ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -95,9 +95,10 @@ import Control.Monad import qualified Data.Set as Set import Data.Char (isSpace) +import Data.Foldable (for_) import Data.Functor ((<&>)) import Data.IORef -import Data.List (intercalate, isPrefixOf, nub, partition) +import Data.List (intercalate, isPrefixOf, nub, partition, sortOn) import Data.Maybe import Control.Concurrent.MVar import qualified Control.Monad.Catch as MC @@ -177,7 +178,7 @@ emptyLoaderState = LoaderState -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] [] emptyUniqDSet) + where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId Nothing [] [] [] emptyUniqDSet) extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO () extendLoadedEnv interp new_bindings = @@ -329,9 +330,8 @@ reallyInitLoaderState interp hsc_env = do -- (a) initialise the C dynamic linker initObjLinker interp - -- (b) Load packages from the command-line (Note [preload packages]) - pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp (hscSetActiveUnitId u hsc_env) (preloadUnits (homeUnitEnv_units env)) pls') (return pls0) (hsc_HUG hsc_env) + pls <- unitEnv_foldWithKey (\k u env -> k >>= \pls' -> loadPackages' interp hsc_env [LibraryUnits {home_unit = u, library_unit = pre} | pre <- preloadUnits (homeUnitEnv_units env)] pls') (return pls0) (hsc_HUG hsc_env) -- steps (c), (d) and (e) loadCmdLineLibs' interp hsc_env pls @@ -881,7 +881,13 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do -- link all "loaded packages" so symbols in those can be resolved -- Note: We are loading packages with local scope, so to see the -- symbols in this link we must link all loaded packages again. - linkDynLib logger tmpfs dflags2 unit_env objs (loaded_pkg_uid <$> eltsUDFM pkgs_loaded) + do + let groupedLoadedPackageInfos = groupLoadedPackageInfosByParent pkgs_loaded + for_ groupedLoadedPackageInfos $ \(mParent, loaded_pkg_uids) -> do + let unit_env' = case mParent of + Nothing -> unit_env + Just parent -> ue_setActiveUnit parent unit_env + linkDynLib logger tmpfs dflags2 unit_env' objs loaded_pkg_uids -- if we got this far, extend the lifetime of the library file changeTempFilesLifetime tmpfs TFL_GhcSession [soFile] @@ -892,6 +898,19 @@ dynLoadObjs interp hsc_env pls@LoaderState{..} objs = do where msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed" + groupOn :: Eq k => (a -> k) -> [a] -> [NE.NonEmpty a] + groupOn f = NE.groupBy ((==) `on2` f) + -- redefine on so we avoid duplicate computation for most values. + where (.*.) `on2` f = \x -> let fx = f x in \y -> fx .*. f y + + groupLoadedPackageInfosByParent :: PkgsLoaded -> [(Maybe UnitId, [UnitId])] + groupLoadedPackageInfosByParent pkgs = + map (\l -> (loaded_pkg_parent (NE.head l), NE.toList $ NE.map loaded_pkg_uid l)) + $ groupOn loaded_pkg_parent + $ sortOn loaded_pkg_parent + $ eltsUDFM pkgs + + rmDupLinkables :: LinkableSet -- Already loaded -> [Linkable] -- New linkables -> (LinkableSet, -- New loaded set (including new ones) @@ -1102,36 +1121,39 @@ loadPackages interp hsc_env new_pkgs = do -- a lock. initLoaderState interp hsc_env modifyLoaderState_ interp $ \pls -> - loadPackages' interp hsc_env new_pkgs pls + loadPackages' interp hsc_env [LibraryUnits {home_unit = hscActiveUnitId hsc_env, library_unit} | library_unit <- new_pkgs] pls -loadPackages' :: Interp -> HscEnv -> [UnitId] -> LoaderState -> IO LoaderState -loadPackages' interp hsc_env new_pks pls = do +loadPackages' :: Interp -> HscEnv -> [LibraryUnits] -> LoaderState -> IO LoaderState +loadPackages' interp hsc_env0 new_pks pls = do pkgs' <- link (pkgs_loaded pls) new_pks return $! pls { pkgs_loaded = pkgs' } where - link :: PkgsLoaded -> [UnitId] -> IO PkgsLoaded + link :: PkgsLoaded -> [LibraryUnits] -> IO PkgsLoaded link pkgs new_pkgs = foldM link_one pkgs new_pkgs - link_one pkgs new_pkg - | new_pkg `elemUDFM` pkgs -- Already linked + link_one pkgs (LibraryUnits {home_unit, library_unit}) + | library_unit `elemUDFM` pkgs -- Already linked = return pkgs - | Just pkg_cfg <- lookupUnitId (hsc_units hsc_env) new_pkg + | Just pkg_cfg <- lookupUnitId (hsc_units (hscSetActiveUnitId home_unit hsc_env)) library_unit = do { let deps = unitDepends pkg_cfg -- Link dependents first - ; pkgs' <- link pkgs deps + ; pkgs' <- link pkgs [LibraryUnits {home_unit, library_unit} | library_unit <- deps] + -- Now link the package itself ; (hs_cls, extra_cls, loaded_dlls) <- loadPackage interp hsc_env pkg_cfg ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg | dep_pkg <- deps , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg) ] - ; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls loaded_dlls trans_deps)) } + ; return (addToUDFM pkgs' library_unit (LoadedPkgInfo library_unit (Just home_unit) hs_cls extra_cls loaded_dlls trans_deps)) } | otherwise - = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS new_pkg))) + = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (unitIdFS library_unit))) + where + hsc_env = hscSetActiveUnitId home_unit hsc_env0 loadPackage :: Interp -> HscEnv -> UnitInfo -> IO ([LibrarySpec], [LibrarySpec], [RemotePtr LoadedDLL]) ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -204,6 +204,7 @@ type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo data LoadedPkgInfo = LoadedPkgInfo { loaded_pkg_uid :: !UnitId + , loaded_pkg_parent :: !(Maybe UnitId) , loaded_pkg_hs_objs :: ![LibrarySpec] , loaded_pkg_non_hs_objs :: ![LibrarySpec] , loaded_pkg_hs_dlls :: ![RemotePtr LoadedDLL] @@ -212,8 +213,9 @@ data LoadedPkgInfo } instance Outputable LoadedPkgInfo where - ppr (LoadedPkgInfo uid hs_objs non_hs_objs _ trans_deps) = - vcat [ppr uid + ppr (LoadedPkgInfo uid parent_uid hs_objs non_hs_objs _ trans_deps) = + vcat [ ppr uid + , ppr parent_uid , ppr hs_objs , ppr non_hs_objs , ppr trans_deps ] ===================================== testsuite/tests/bytecode/T25090/all.T ===================================== @@ -1,51 +1,51 @@ -# This test compiles the boot file separately from its source file, which causes -# a debug assertion warning. -# Since this appears to be intentional according to the Note [Loading your own hi-boot file], -# the warning is added to the expected stderr for debugged builds. -def test_T25090(name): - assert_warn_spec = {'stderr': 'T25090-debug.stderr'} - extra_specs = assert_warn_spec if name == 'T25090a' and compiler_debugged() else {} - return test(name, - [extra_files(['A.hs', 'B.hs', 'C.hs-boot', 'C.hs', 'D.hs']), - req_th, - js_skip, - use_specs(dict(stdout = 'T25090.stdout', **extra_specs)), - ], - makefile_test, - []) - -test_T25090('T25090a') -test_T25090('T25090b') - -def test_pkg(name, files = []): - test( - name, - [ - extra_files([ - 'PkgBytecode.hs', - 'Local.hs', - 'Dep.hs', - 'DepApi.hs', - 'Num.hs', - 'Num.hs-boot', - 'dep.conf', - 'prep.bash', - 'run.bash', - ] + files), - req_th, - js_skip, - windows_skip, - use_specs({'stdout': 'PkgBytecode.stdout'}), - ], - makefile_test, - [], - ) - -test_pkg('T25090_pkg') -test_pkg('T25090_pkg_empty') -test_pkg('T25090_pkg_nolib') -test_pkg('T25090_pkg_obj_code') -test_pkg('T25090_pkg_multi_unit', ['unit1', 'unit2']) -# TODO this doesn't work, because `locateLib` ignores static archives when the interpreter is dynamic, even though a -# comment says "search for .so libraries _first_" (rather than "only"). -# test_pkg('T25090_pkg_archive') +# # This test compiles the boot file separately from its source file, which causes +# # a debug assertion warning. +# # Since this appears to be intentional according to the Note [Loading your own hi-boot file], +# # the warning is added to the expected stderr for debugged builds. +# def test_T25090(name): +# assert_warn_spec = {'stderr': 'T25090-debug.stderr'} +# extra_specs = assert_warn_spec if name == 'T25090a' and compiler_debugged() else {} +# return test(name, +# [extra_files(['A.hs', 'B.hs', 'C.hs-boot', 'C.hs', 'D.hs']), +# req_th, +# js_skip, +# use_specs(dict(stdout = 'T25090.stdout', **extra_specs)), +# ], +# makefile_test, +# []) +# +# test_T25090('T25090a') +# test_T25090('T25090b') +# +# def test_pkg(name, files = []): +# test( +# name, +# [ +# extra_files([ +# 'PkgBytecode.hs', +# 'Local.hs', +# 'Dep.hs', +# 'DepApi.hs', +# 'Num.hs', +# 'Num.hs-boot', +# 'dep.conf', +# 'prep.bash', +# 'run.bash', +# ] + files), +# req_th, +# js_skip, +# windows_skip, +# use_specs({'stdout': 'PkgBytecode.stdout'}), +# ], +# makefile_test, +# [], +# ) +# +# test_pkg('T25090_pkg') +# test_pkg('T25090_pkg_empty') +# test_pkg('T25090_pkg_nolib') +# test_pkg('T25090_pkg_obj_code') +# test_pkg('T25090_pkg_multi_unit', ['unit1', 'unit2']) +# # TODO this doesn't work, because `locateLib` ignores static archives when the interpreter is dynamic, even though a +# # comment says "search for .so libraries _first_" (rather than "only"). +# # test_pkg('T25090_pkg_archive') ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepA/A.hs ===================================== @@ -0,0 +1,9 @@ + +module A (a) where + +import Dep1 (d) + +import Data.Text qualified as Text + +a :: Int +a = d ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/DepC/C.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} + +module C where + +import Language.Haskell.TH.Syntax (lift) +import A (a) + +c :: Int +c = $(lift a) + ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/Makefile ===================================== @@ -0,0 +1,28 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +test-bc: prepare + '$(TEST_HC)' -fprefer-byte-code -fbyte-code-and-object-code -dynamic -unit @unita -unit @unitc + +test-obj: prepare + '$(TEST_HC)' -dynamic -unit @unita -unit @unitc + +# make test should not yield +# <no location info>: error: unknown unit: dep1-1 + +prepare: clean + '$(TEST_HC)' -c ./dep1/Dep1.hs -this-unit-id dep1-1 -dynamic -no-link -fPIC -osuf dyn_o -hisuf dyn_hi -o ./dep1/Dep1.dyn_o + '$(TEST_HC)' -shared -dynamic -fPIC -o ./dep1/libHSdep1-1-ghc9.10.1.so ./dep1/Dep1.dyn_o + '$(GHC_PKG)' --package-db dep1 recache + +clean: + $(RM) **/*.dyn_hi + $(RM) **/*.dyn_o + $(RM) **/*.hi + $(RM) **/*.o + $(RM) **/*.so + $(RM) dep1/package.cache + $(RM) dep1/package.cache.lock + $(RM) libHSdep1-1-ghc9.10.1.so + ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/all.T ===================================== @@ -0,0 +1,9 @@ +# We just want compilation to succeed here +test('mhu-transitive-th-deps-bc', + [ extra_files(["dep1", "DepA", "DepC", "unita","unitc"]) + ], makefile_test, ['test-bc']) + +test('mhu-transitive-th-deps-obj', + [ extra_files(["dep1", "DepA", "DepC", "unita","unitc"]) + ], makefile_test, ['test-obj']) + ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/Dep1.hs ===================================== @@ -0,0 +1,6 @@ + +module Dep1 (d) where + +d :: Int +d = 42 + ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/dep1/dep1.conf ===================================== @@ -0,0 +1,9 @@ +name: dep1 +version: 1 +visibility: public +id: dep1-1 +exposed: False +exposed-modules: Dep1 +import-dirs: ${pkgroot}/dep1 +library-dirs: ${pkgroot}/dep1 +hs-libraries: HSdep1-1 ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-bc.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 2] Compiling A ( DepA/A.hs, DepA/A.o, interpreted )[unita] +[2 of 2] Compiling C ( DepC/C.hs, DepC/C.o, interpreted )[unitc] ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/mhu-transitive-th-deps-obj.stdout ===================================== @@ -0,0 +1,2 @@ +[1 of 2] Compiling A ( DepA/A.hs, DepA/A.o )[unita] +[2 of 2] Compiling C ( DepC/C.hs, DepC/C.o )[unitc] ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unita ===================================== @@ -0,0 +1 @@ +-iDepA -this-unit-id unita -hide-all-packages -package base -package text -package-db dep1 -package dep1 A ===================================== testsuite/tests/driver/multipleHomeUnits/mhu-transitive-th-deps/unitc ===================================== @@ -0,0 +1 @@ +-iDepC -this-unit-id unitc -hide-all-packages -package-id unita -package base -package template-haskell C View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8323b4b98a498628021d037253034f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8323b4b98a498628021d037253034f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/subordinate-export-namespaces] 11 commits: Fix stack decoding when using profiled runtime
by Vladislav Zavialov (＠int-index) 29 Oct '25

29 Oct '25

Vladislav Zavialov pushed to branch wip/int-index/subordinate-export-namespaces at Glasgow Haskell Compiler / GHC Commits: 38d65187 by Matthew Pickering at 2025-10-21T13:12:20+01:00 Fix stack decoding when using profiled runtime There are three fixes in this commit. * We need to replicate the `InfoTable` and `InfoTableProf` approach for the other stack constants (see the new Stack.ConstantsProf file). * Then we need to appropiately import the profiled or non-profiled versions. * Finally, there was an incorrect addition in `stackFrameSize`. We need to cast after performing addition on words. Fixes #26507 - - - - - 17231bfb by fendor at 2025-10-21T13:12:20+01:00 Add regression test for #26507 - - - - - 4f5bf93b by Simon Peyton Jones at 2025-10-25T04:05:34-04:00 Postscript to fix for #26255 This MR has comments only - - - - - 6ef22fa0 by IC Rainbow at 2025-10-26T18:23:01-04:00 Add SIMD primops for bitwise logical operations This adds 128-bit wide and/or/xor instructions for X86 NCG, with both SSE and AVX encodings. ``` andFloatX4# :: FloatX4# -> FloatX4# -> FloatX4# -- andps / vandps andDoubleX2# :: DoubleX2# -> DoubleX2# -> DoubleX2# -- andpd / vandpd andInt8X16# :: Int8X16# -> Int8X16# -> Int8X16# -- pand / vpand ``` The new primops are available on ARM when using LLVM backend. Tests added: - simd015 (floats and doubles) - simd016 (integers) - simd017 (words) Fixes #26417 - - - - - fbdc623a by sheaf at 2025-10-26T18:23:52-04:00 Add hints for unsolved HasField constraints This commit adds hints and explanations for unsolved 'HasField' constraints. GHC will now provide additional explanations for an unsolved constraint of the form 'HasField fld_name rec_ty fld_ty'; the details are laid out in Note [Error messages for unsolved HasField constraints], but briefly: 1. Provide similar name suggestions (e.g. mis-spelled field name) and import suggestions (record field not in scope). These result in actionable 'GhcHints', which is helpful to provide code actions in HLS. 2. Explain why GHC did not solve the constraint, e.g.: - 'fld_name' is not a string literal (e.g. a type variable) - 'rec_ty' is a TyCon without any fields, e.g. 'Int' or 'Bool'. - 'fld_ty' contains existentials variables or foralls. - The record field is a pattern synonym field (GHC does not generate HasField instances for those). - 'HasField' is a custom 'TyCon', not actually the built-in 'HasField' typeclass from 'GHC.Records'. On the way, we slightly refactor the mechanisms for import suggestions in GHC.Rename.Unbound. This is to account for the fact that, for 'HasField', we don't care whether the field is imported qualified or unqualified. 'importSuggestions' was refactored, we now have 'sameQualImportSuggestions' and 'anyQualImportSuggestions'. Fixes #18776 #22382 #26480 - - - - - 99d5707f by sheaf at 2025-10-26T18:23:52-04:00 Rename PatSyn MatchContext to PatSynCtx to avoid punning - - - - - 5dc2e9ea by Julian Ospald at 2025-10-27T18:17:23-04:00 Skip uniques test if sources are not available - - - - - 544b9ec9 by Vladislav Zavialov at 2025-10-27T18:18:06-04:00 Re-export GHC.Hs.Basic from GHC.Hs Clean up some import sections in GHC by re-exporting GHC.Hs.Basic from GHC.Hs. - - - - - 643ce801 by Julian Ospald at 2025-10-28T18:18:55-04:00 rts: remove unneccesary cabal flags We perform those checks via proper autoconf macros instead that do the right thing and then add those libs to the rts buildinfo. - - - - - d69ea8fe by Vladislav Zavialov at 2025-10-28T18:19:37-04:00 Test case for #17705 Starting with GHC 9.12 (the first release to include 5745dbd3), all examples in this ticket are handled as expected. - - - - - 5120a24a by Vladislav Zavialov at 2025-10-29T20:54:07+03:00 Fix namespace specifiers in subordinate exports (#12488) This patch fixes an oversight in the `lookupChildrenExport` function that caused explicit namespace specifiers of subordinate export items to be ignored: module M (T (type A)) where -- should be rejected data T = A Based on the `IEWrappedName` data type, there are 5 cases to consider: 1. Unadorned name: P(X) 2. Named default: P(default X) 3. Pattern synonym: P(pattern X) 4. Type name: P(type X) 5. Data name: P(data X) Case 1 is already handled correctly; cases 2 and 3 are parse errors; and it is cases 4 and 5 that we are concerned with in this patch. Following the precedent established in `LookupExactName`, we introduce a boolean flag in `LookupChildren` to control whether to look up in all namespaces or in a specific one. If an export item is accompanied by an explicit namespace specifier `type` or `data`, we restrict the lookup in `lookupGRE` to a specific namespace. The newly introduced diagnostic `TcRnExportedSubordinateNotFound` provides error messages and suggestions more tailored to this context than the previously used `reportUnboundName`. - - - - - 117 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Expr.hs - docs/users_guide/9.16.1-notes.rst - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-internal/cbits/Stack_c.c - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/tests/backtraces/T26507.hs - + libraries/ghc-internal/tests/backtraces/T26507.stderr - libraries/ghc-internal/tests/backtraces/all.T - libraries/ghc-internal/tests/stack-annotation/all.T - libraries/ghc-prim/changelog.md - m4/fp_check_pthreads.m4 - rts/configure.ac - + rts/rts.buildinfo.in - rts/rts.cabal - 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/linters/all.T - testsuite/tests/module/mod4.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480.stderr - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux1.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480_aux2.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.hs - + testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr - testsuite/tests/overloadedrecflds/should_fail/all.T - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - + testsuite/tests/parser/should_fail/T12488c.hs - + testsuite/tests/parser/should_fail/T12488c.stderr - + testsuite/tests/parser/should_fail/T12488d.hs - + testsuite/tests/parser/should_fail/T12488d.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/rename/should_compile/T12488b.hs - + testsuite/tests/rename/should_compile/T12488f.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T12488a.hs - + testsuite/tests/rename/should_fail/T12488a.stderr - + testsuite/tests/rename/should_fail/T12488a_foo.hs - + testsuite/tests/rename/should_fail/T12488a_foo.stderr - + testsuite/tests/rename/should_fail/T12488e.hs - + testsuite/tests/rename/should_fail/T12488e.stderr - + testsuite/tests/rename/should_fail/T12488g.hs - + testsuite/tests/rename/should_fail/T12488g.stderr - testsuite/tests/rename/should_fail/T19843h.stderr - testsuite/tests/rename/should_fail/T25899e2.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/simd/should_run/all.T - + testsuite/tests/simd/should_run/simd015.hs - + testsuite/tests/simd/should_run/simd015.stdout - + testsuite/tests/simd/should_run/simd016.hs - + testsuite/tests/simd/should_run/simd016.stdout - + testsuite/tests/simd/should_run/simd017.hs - + testsuite/tests/simd/should_run/simd017.stdout - + testsuite/tests/typecheck/should_compile/T17705.hs - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb2f9d1ff507ff37410de3adc8197… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb2f9d1ff507ff37410de3adc8197… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/subordinate-export-namespaces] Better error messages and hints
by Vladislav Zavialov (＠int-index) 29 Oct '25

29 Oct '25

Vladislav Zavialov pushed to branch wip/int-index/subordinate-export-namespaces at Glasgow Haskell Compiler / GHC Commits: dfb2f9d1 by Vladislav Zavialov at 2025-10-29T16:03:47+03:00 Better error messages and hints - - - - - 20 changed files: - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - testsuite/tests/module/mod4.stderr - testsuite/tests/rename/should_compile/T12488b.hs - + testsuite/tests/rename/should_compile/T12488f.hs - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_fail/T12488a.hs - testsuite/tests/rename/should_fail/T12488a.stderr - testsuite/tests/rename/should_fail/T12488a_foo.stderr - testsuite/tests/rename/should_fail/T12488e.hs - testsuite/tests/rename/should_fail/T12488e.stderr - + testsuite/tests/rename/should_fail/T12488g.hs - + testsuite/tests/rename/should_fail/T12488g.stderr - testsuite/tests/rename/should_fail/T25899e2.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -23,6 +23,7 @@ module GHC.Rename.Names ( checkConName, mkChildEnv, findChildren, + mkBadExportSubordinate, findImportUsage, getMinimalImports, printMinimalImports, @@ -1423,6 +1424,15 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) where name = greName gre +-- | Assuming a subordinate item could not be found, do another lookup for a +-- more specific error message. +mkBadExportSubordinate :: [GlobalRdrElt] -> LIEWrappedName GhcPs -> BadExportSubordinate +mkBadExportSubordinate child_gres n = + case lookupChildren child_gres [n] of + (LookupChildNonType {lce_nontype_item = g} : _, _) -> BadExportSubordinateNonType g + (LookupChildNonData {lce_nondata_item = g} : _, _) -> BadExportSubordinateNonData g + _ -> BadExportSubordinateNotFound n + type IELookupM = MaybeErr IELookupError data IELookupWarning ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -674,6 +674,43 @@ instance Diagnostic TcRnMessage where what_is = pp_category ty_thing thing = ppr $ nameOccName child parents = map ppr parent_names + TcRnExportedSubordinateNotFound parent_gre k _ -> + mkSimpleDecorated $ + case k of + BadExportSubordinateNotFound wname -> + let child_name = lieWrappedName wname + child_name_fs = occNameFS (rdrNameOcc child_name) + suggest_patsyn = allow_patsyn && could_be_patsyn + could_be_patsyn = + case unLoc wname of + IEName{} -> isLexCon child_name_fs + IEData{} -> isLexCon child_name_fs + IEPattern{} -> True + IEType{} -> False + IEDefault{} -> False + basic_msg = + what_parent <+> quotes (ppr parent_name) + <+> "does not define a child named" <+> quotes (ppr child_name) + patsyn_msg = + text "nor is there a pattern synonym of that name in scope" + combined_msg + | suggest_patsyn = basic_msg <> comma $$ patsyn_msg <> dot + | otherwise = basic_msg <> dot + in combined_msg + BadExportSubordinateNonType gre -> + let child_name = greName gre + in what_parent <+> quotes (ppr parent_name) <+> "defines a child named" <+> quotes (ppr child_name) <> comma + $$ text "but it is not in the type namespace." + BadExportSubordinateNonData gre -> + let child_name = greName gre + in what_parent <+> quotes (ppr parent_name) <+> "defines a child named" <+> quotes (ppr child_name) <> comma + $$ text "but it is not in the data namespace." + where + parent_name = greName parent_gre + (what_parent, allow_patsyn) = case greInfo parent_gre of + IAmTyCon ClassFlavour -> (text "The class", False) + IAmTyCon _ -> (text "The data type", True) + _ -> (text "The item", False) TcRnConflictingExports occ child_gre1 ie1 child_gre2 ie2 -> mkSimpleDecorated $ vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon @@ -2203,6 +2240,8 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnDuplicateExports TcRnExportedParentChildMismatch{} -> ErrorWithoutFlag + TcRnExportedSubordinateNotFound{} + -> ErrorWithoutFlag TcRnConflictingExports{} -> ErrorWithoutFlag TcRnDuplicateFieldExport {} @@ -2874,6 +2913,13 @@ instance Diagnostic TcRnMessage where -> noHints TcRnExportedParentChildMismatch{} -> noHints + TcRnExportedSubordinateNotFound _ k similar_names + -> ns_spec_hints ++ similar_names + where + ns_spec_hints = case k of + BadExportSubordinateNotFound{} -> noHints + BadExportSubordinateNonType{} -> [SuggestChangeExportItem ExportItemRemoveSubordinateType] + BadExportSubordinateNonData{} -> [SuggestChangeExportItem ExportItemRemoveSubordinateData] TcRnConflictingExports{} -> noHints TcRnDuplicateFieldExport {} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -83,7 +83,6 @@ module GHC.Tc.Errors.Types ( , Subordinate(..), pprSubordinate , ImportError(..) , WhatLooking(..) - , lookingForSubordinate , HoleError(..) , CoercibleMsg(..) , PotentialInstances(..) @@ -114,6 +113,7 @@ module GHC.Tc.Errors.Types ( , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons , BadImportKind(..) + , BadExportSubordinate(..) , DodgyImportsReason (..) , ImportLookupExtensions (..) , ImportLookupReason (..) @@ -1663,6 +1663,26 @@ data TcRnMessage where -> Name -- ^ child -> [Name] -> TcRnMessage + {-| TcRnExportedSubordinateNotFound is an error that occurs when the name of a + subordinate export item is not in scope. + + Example: + module M (T(X)) where -- X is not in scope + data T = Y + + Test cases: module/mod4 + rename/should_fail/T12488a + rename/should_fail/T12488a_foo + rename/should_fail/T12488e + rename/should_fail/T12488g + rename/should_fail/T25899e2 + -} + TcRnExportedSubordinateNotFound + :: GlobalRdrElt -- ^ parent + -> BadExportSubordinate + -> [GhcHint] -- ^ similar name suggestions + -> TcRnMessage + {-| TcRnConflictingExports is an error that occurs when different identifiers that have the same name are being exported by a module. @@ -5822,6 +5842,11 @@ data BadImportKind | BadImportAvailVar deriving Generic +data BadExportSubordinate + = BadExportSubordinateNotFound !(LIEWrappedName GhcPs) + | BadExportSubordinateNonType !GlobalRdrElt + | BadExportSubordinateNonData !GlobalRdrElt + {- Note [Reasons for BadImportAvailTyCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ BadImportAvailTyCon means a name is available in the TcCls namespace @@ -6016,15 +6041,6 @@ data WhatLooking = WL_Anything -- is no point in suggesting alternative spellings deriving (Eq, Show) --- | In what namespaces should we look for a subordinate --- of the given 'GlobalRdrElt'. -lookingForSubordinate :: GlobalRdrElt -> WhatLooking -lookingForSubordinate parent_gre = - case greInfo parent_gre of - IAmTyCon ClassFlavour - -> WL_TyCon_or_TermVar - _ -> WL_Term - -- | This datatype collates instances that match or unifier, -- in order to report an error message for an unsolved typeclass constraint. data PotentialInstances ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Rename.Doc import GHC.Rename.Module import GHC.Rename.Names import GHC.Rename.Env -import GHC.Rename.Unbound ( reportUnboundName ) +import GHC.Rename.Unbound ( mkUnboundNameRdr ) import GHC.Rename.Splice import GHC.Unit.Module import GHC.Unit.Module.Imported @@ -30,6 +30,7 @@ import GHC.Unit.Module.Warnings import GHC.Core.TyCon import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc (fuzzyLookup) import GHC.Core.ConLike import GHC.Core.PatSyn import GHC.Data.Maybe @@ -49,6 +50,7 @@ import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Name.Reader +import GHC.Types.Hint import Control.Arrow ( first ) import Control.Monad ( when ) @@ -589,8 +591,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_kids_with :: GlobalRdrElt -> [LIEWrappedName GhcPs] -> RnM ([LIEWrappedName GhcRn], [GlobalRdrElt]) lookup_ie_kids_with gre sub_rdrs = - do { kids <- lookupChildrenExport gre sub_rdrs - ; return (map fst kids, map snd kids) } + do { let child_gres = findChildren kids_env (greName gre) + ; kids <- lookupChildrenExport gre child_gres sub_rdrs + ; return (unzip kids) } lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt -> RnM [GlobalRdrElt] @@ -781,9 +784,10 @@ If the module has NO main function: lookupChildrenExport :: GlobalRdrElt + -> [GlobalRdrElt] -> [LIEWrappedName GhcPs] -> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)]) -lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items +lookupChildrenExport parent_gre child_gres rdr_items = mapAndReportM doOne rdr_items where spec_parent = greName parent_gre -- Process an individual child @@ -794,23 +798,20 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items let all_ns = case unLoc n of IEName{} -> True -- Ignore the namespace iff the name is unadorned _ -> False - let bareName = (ieWrappedName . unLoc) n + let bareName = lieWrappedName n -- Do not report export list declaration deprecations name <- lookupSubBndrOcc_helper False all_ns ExportDeprecationWarnings (ParentGRE spec_parent (greInfo parent_gre)) bareName traceRn "lookupChildrenExport" (ppr name) - -- Default to data namespace for slightly better error messages - let unboundName :: RdrName - unboundName - | all_ns = fromMaybe bareName (demoteRdrName bareName) - | otherwise = bareName case name of NameNotFound -> - do { ub <- reportUnboundName (lookingForSubordinate parent_gre) unboundName - ; let l = getLoc n - gre = mkLocalGRE UnboundGRE NoParent ub - ; return (L l (IEName noExtField (L (l2l l) ub)), gre)} + do { let err = mkBadExportSubordinate child_gres n + similar_names = subordinateExportSimilarNames bareName child_gres + ; addDiagnosticTc (TcRnExportedSubordinateNotFound parent_gre err similar_names) + ; let ub = mkUnboundNameRdr bareName + ; let gre = mkLocalGRE UnboundGRE NoParent ub + ; return (replaceLWrappedName n ub, gre)} FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> do { checkPatSynParent spec_parent par child_nm ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm) @@ -818,6 +819,22 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items } IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs +subordinateExportSimilarNames :: RdrName -> [GlobalRdrElt] -> [GhcHint] +subordinateExportSimilarNames rdr_name child_gres = + -- At the moment, we only suggest other children of the same parent. + -- One possible improvement would be to suggest bundling pattern synonyms with + -- data types, but not with classes or type data. + case NE.nonEmpty similar_names of + Nothing -> [] + Just nms -> [SuggestSimilarNames rdr_name (fmap SimilarName nms)] + where + occ_name = rdrNameOcc rdr_name + similar_names = + fuzzyLookup (occNameString occ_name) + [(occNameString child_occ_name, greName gre) + | gre <- child_gres + , let child_occ_name = greOccName gre + , occNameFS occ_name /= occNameFS child_occ_name ] -- Note [Typing Pattern Synonym Exports] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -510,6 +510,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnDuplicateExport" = 47854 GhcDiagnosticCode "TcRnDuplicateNamedDefaultExport" = 31584 GhcDiagnosticCode "TcRnExportedParentChildMismatch" = 88993 + GhcDiagnosticCode "TcRnExportedSubordinateNotFound" = 11592 GhcDiagnosticCode "TcRnConflictingExports" = 69158 GhcDiagnosticCode "TcRnDuplicateFieldExport" = 97219 GhcDiagnosticCode "TcRnAmbiguousFieldInUpdate" = 56428 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -7,6 +7,7 @@ module GHC.Types.Hint ( , LanguageExtensionHint(..) , ImportItemSuggestion(..) , ImportSuggestion(..) + , ExportItemSuggestion(..) , HowInScope(..) , SimilarName(..) , StarIsType(..) @@ -411,6 +412,12 @@ data GhcHint -} | ImportSuggestion OccName ImportSuggestion + {-| Suggest to change an export item, e.g. to remove a namespace specifier. + + Test cases: T12488a, T12488a_foo, T12488e, T12488g, T25899e2 + -} + | SuggestChangeExportItem ExportItemSuggestion + {-| Found a pragma in the body of a module, suggest placing it in the header. -} | SuggestPlacePragmaInHeader @@ -551,6 +558,11 @@ data ImportItemSuggestion = -- Why no 'ImportItemAddData'? Because the suggestion to add 'data' is -- represented by the 'ImportDataCon' constructor of 'ImportSuggestion'. +-- | Suggest to change an export item. +data ExportItemSuggestion = + ExportItemRemoveSubordinateType + | ExportItemRemoveSubordinateData + -- | Suggest how to fix an import. data ImportSuggestion -- | Some module exports what we want, but we aren't explicitly importing it. ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -210,6 +210,10 @@ instance Outputable GhcHint where <+> pprQuotedList parents ImportSuggestion occ_name import_suggestion -> pprImportSuggestion occ_name import_suggestion + SuggestChangeExportItem export_item_suggestion + -> case export_item_suggestion of + ExportItemRemoveSubordinateType -> text "Remove the" <+> quotes (text "type") <+> text "keyword" + ExportItemRemoveSubordinateData -> text "Remove the" <+> quotes (text "data") <+> text "keyword" SuggestPlacePragmaInHeader -> text "Perhaps you meant to place it in the module header?" $$ text "The module header is the section at the top of the file, before the" <+> quotes (text "module") <+> text "keyword" ===================================== testsuite/tests/module/mod4.stderr ===================================== @@ -1,5 +1,6 @@ - -mod4.hs:2:10: error: [GHC-76037] - • Not in scope: data constructor ‘K2’ +mod4.hs:2:10: error: [GHC-11592] + • The data type ‘T’ does not define a child named ‘K2’, + nor is there a pattern synonym of that name in scope. • In the export: T(K1, K2) - Suggested fix: Perhaps use ‘K1’ (line 3) + Suggested fix: Perhaps use ‘K1’ (Defined at mod4.hs:3:10) + ===================================== testsuite/tests/rename/should_compile/T12488b.hs ===================================== @@ -1,4 +1,24 @@ {-# LANGUAGE ExplicitNamespaces #-} -module T12488b ( T (data A) ) where +{-# LANGUAGE TypeFamilies #-} -data T = A +module T12488b + ( T ( data A, -- data constructor (alphanumeric name) + data fld, -- record field (alphanumeric name) + data (:!!), -- data constructor (symbolic name) + data (///) -- record field (symbolic name) + ), + C ( type F, -- associated type (alphanumeric name) + data meth, -- class method (alphanumeric name) + type (+++), -- associated type (symbolic name) + data (***) -- class method (symbolic name) + ), + ) where + +data T = A { fld :: Int } + | (:!!) { (///) :: Int -> Int } + +class C a where + type F a + type (+++) a + meth :: a -> a + (***) :: a -> a -> a ===================================== testsuite/tests/rename/should_compile/T12488f.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE TypeFamilies #-} + +module T12488f + ( C ( type (+++), -- associated type (symbolic name) + data (++-) -- class method (symbolic name) + ), + ) where + +class C a where + type (+++) a -- exported + type (++-) a -- not exported + (+++) :: a -> a -- not exported + (++-) :: a -> a -- exported ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -246,3 +246,4 @@ test('T25899b', normal, compile, ['']) test('T25899c', [extra_files(['T25899c_helper.hs'])], multimod_compile, ['T25899c', '-v0']) test('T25899d', combined_output, ghci_script, ['T25899d.script']) test('T12488b', normal, compile, ['']) +test('T12488f', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T12488a.hs ===================================== @@ -1,4 +1,9 @@ {-# LANGUAGE ExplicitNamespaces #-} -module T12488a ( T (type A) ) where +module T12488a + ( T (type A) + , (:!) (type (:/)) + ) where data T = A + +data (:!) = (:/) \ No newline at end of file ===================================== testsuite/tests/rename/should_fail/T12488a.stderr ===================================== @@ -1,5 +1,12 @@ -T12488a.hs:2:18: error: [GHC-76037] - • Not in scope: type constructor or class ‘A’ +T12488a.hs:3:5: error: [GHC-11592] + • The data type ‘T’ defines a child named ‘A’, + but it is not in the type namespace. • In the export: T(type A) - Suggested fix: Perhaps use data constructor ‘A’ (line 4) + Suggested fix: Remove the ‘type’ keyword + +T12488a.hs:4:5: error: [GHC-11592] + • The data type ‘:!’ defines a child named ‘:/’, + but it is not in the type namespace. + • In the export: (:!)(type (:/)) + Suggested fix: Remove the ‘type’ keyword ===================================== testsuite/tests/rename/should_fail/T12488a_foo.stderr ===================================== @@ -1,5 +1,6 @@ -T12488a_foo.hs:3:22: error: [GHC-76037] - • Not in scope: type constructor or class ‘A’ +T12488a_foo.hs:3:22: error: [GHC-11592] + • The data type ‘T’ defines a child named ‘A’, + but it is not in the type namespace. • In the export: T(type A) - Suggested fix: Perhaps use data constructor ‘A’ (line 5) + Suggested fix: Remove the ‘type’ keyword ===================================== testsuite/tests/rename/should_fail/T12488e.hs ===================================== @@ -1,6 +1,12 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE TypeFamilies #-} -module T12488e ( C (data A) ) where +module T12488e + ( C (data A) + , D (data (+++)) + ) where class C a where type A a + +class D a where + type (+++) a \ No newline at end of file ===================================== testsuite/tests/rename/should_fail/T12488e.stderr ===================================== @@ -1,5 +1,12 @@ -T12488e.hs:3:18: error: [GHC-76037] - • Not in scope: data constructor ‘A’ +T12488e.hs:4:5: error: [GHC-11592] + • The class ‘C’ defines a child named ‘A’, + but it is not in the data namespace. • In the export: C(data A) - Suggested fix: Perhaps use type constructor or class ‘A’ (line 6) + Suggested fix: Remove the ‘data’ keyword + +T12488e.hs:5:5: error: [GHC-11592] + • The class ‘D’ defines a child named ‘+++’, + but it is not in the data namespace. + • In the export: D(data (+++)) + Suggested fix: Remove the ‘data’ keyword ===================================== testsuite/tests/rename/should_fail/T12488g.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE TypeFamilies #-} +module T12488g + ( C (data (+++), + type (++-)) + ) where + +class C a where + type (+++) a + (++-) :: a -> a ===================================== testsuite/tests/rename/should_fail/T12488g.stderr ===================================== @@ -0,0 +1,16 @@ +T12488g.hs:4:5: error: [GHC-11592] + • The class ‘C’ defines a child named ‘++-’, + but it is not in the type namespace. + • In the export: C(data (+++), type (++-)) + Suggested fixes: + • Remove the ‘type’ keyword + • Perhaps use ‘+++’ (Defined at T12488g.hs:9:3) + +T12488g.hs:4:5: error: [GHC-11592] + • The class ‘C’ defines a child named ‘+++’, + but it is not in the data namespace. + • In the export: C(data (+++), type (++-)) + Suggested fixes: + • Remove the ‘data’ keyword + • Perhaps use ‘++-’ (Defined at T12488g.hs:10:3) + ===================================== testsuite/tests/rename/should_fail/T25899e2.stderr ===================================== @@ -1,4 +1,6 @@ -T25899e2.hs:5:5: error: [GHC-76037] - • Not in scope: data constructor ‘MkT’ +T25899e2.hs:5:5: error: [GHC-11592] + • The data type ‘T’ defines a child named ‘MkT’, + but it is not in the data namespace. • In the export: type T(data MkT) + Suggested fix: Remove the ‘data’ keyword ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -249,3 +249,4 @@ test('T25899f', [extra_files(['T25899f_helper.hs'])], multimod_compile_fail, [' test('T12488a', normal, compile_fail, ['']) test('T12488a_foo', normal, compile_fail, ['']) test('T12488e', normal, compile_fail, ['']) +test('T12488g', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb2f9d1ff507ff37410de3adc8197f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb2f9d1ff507ff37410de3adc8197f… You're receiving this email because of your account on gitlab.haskell.org.

1 0