May 2026 - ghc-commits

[Git][ghc/ghc][master] Event/Windows.hsc: rethrow exceptions in overlapped IO
by Marge Bot (＠marge-bot) 28 May '26

28 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 037a80dc by Tom McLaughlin at 2026-05-28T12:24:36-04:00 Event/Windows.hsc: rethrow exceptions in overlapped IO This prevents the WinIO manager from swallowing exceptions in overlapped IO. It was added to make WinIO support possible in the `network` library. See https://gitlab.haskell.org/ghc/ghc/-/issues/27283. We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP. - - - - - 3 changed files: - + changelog.d/windows-rethrow-overlapped-exception - compiler/GHC/SysTools/Cpp.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc Changes: ===================================== changelog.d/windows-rethrow-overlapped-exception ===================================== @@ -0,0 +1,8 @@ +section: rts +synopsis: Rethrow exceptions in overlapped IO when using the WinIO IO manager. +issues: #27283 +mrs: !15887 + +description: { + This change was made to support WinIO in the network library; see https://github.com/haskell/network/issues/602. +} ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -148,7 +148,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do -- and BUILD is the same as our HOST. let io_manager_defs = - [ "-D__IO_MANAGER_WINIO__=1" | isWindows ] ++ + [ "-D__IO_MANAGER_WINIO__=2" | isWindows ] ++ [ "-D__IO_MANAGER_MIO__=1" ] let sse_defs = ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc ===================================== @@ -690,7 +690,11 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do -- can go into an unbounded alertable wait. delay <- runExpiredTimeouts mgr registerAlertableWait delay - return $ IOFailed Nothing + -- Re-throw the original exception rather than + -- returning IOFailed. This ensures that async + -- exceptions (e.g. Timeout from System.Timeout) + -- propagate correctly to their handlers. + E.throw e let runner = do debugIO $ (dbgMsg ":: waiting ") ++ " | " ++ show lpol res <- readMVar signal `catch` cancel debugIO $ dbgMsg ":: signaled " View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/037a80dc65d3975adf4a35d46876850… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/037a80dc65d3975adf4a35d46876850… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fixes for black holes
by Marge Bot (＠marge-bot) 28 May '26

28 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 63ce5770 by Luite Stegeman at 2026-05-28T12:23:35-04:00 Fixes for black holes - suspend duplicate work for eager black holes - detect eager black holes in checkBlockingQueues - don't overwrite existing black holes even if they're not in an eager blackhole frame - don't deadlock on self when thunk is already blackholed Fixes #26936 - - - - - 6 changed files: - + changelog.d/fix-blackhole-handling - rts/Messages.c - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/include/rts/storage/ClosureMacros.h Changes: ===================================== changelog.d/fix-blackhole-handling ===================================== @@ -0,0 +1,6 @@ +section: rts +synopsis: Fix several black hole handling bugs that could lead to deadlocks + or crashes in multithreaded programs. These could show up as the program + hanging or "END_TSO_QUEUE object entered" errors. +issues: #26922 #26936 +mrs: !15640 ===================================== rts/Messages.c ===================================== @@ -188,10 +188,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) // BLACKHOLE has already been updated, and GC has shorted out the // indirection, so the pointer no longer points to a BLACKHOLE at // all. - if (bh_info != &stg_BLACKHOLE_info && - bh_info != &stg_CAF_BLACKHOLE_info && - bh_info != &__stg_EAGER_BLACKHOLE_info && - bh_info != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(bh_info)) { return 0; } @@ -350,10 +347,7 @@ StgTSO * blackHoleOwner (StgClosure *bh) info = RELAXED_LOAD(&bh->header.info); - if (info != &stg_BLACKHOLE_info && - info != &stg_CAF_BLACKHOLE_info && - info != &__stg_EAGER_BLACKHOLE_info && - info != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(info)) { return NULL; } ===================================== rts/ThreadPaused.c ===================================== @@ -183,6 +183,30 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom) } } +/* + * Check whether tso is the owner of the black hole bh. + * + * We must call this from the capability that runs tso, + * since that guarantees that the writes to bh->indirectee + * by tso claiming ownership have been visible. If another + * tso has claimed it again afterwards we can safely suspend + * our work. + */ +static bool +threadPausedBlackHoleOwner(StgTSO *tso, StgClosure *bh) +{ + StgClosure *ind = RELAXED_LOAD(&((StgInd*)bh)->indirectee); + if (ind == (StgClosure*)tso) { + return true; + } + const StgInfoTable *ind_info = GET_INFO(UNTAG_CLOSURE(ind)); + if (ind_info == &stg_BLOCKING_QUEUE_CLEAN_info + || ind_info == &stg_BLOCKING_QUEUE_DIRTY_info) { + return ((StgBlockingQueue*)UNTAG_CLOSURE(ind))->owner == tso; + } + return false; +} + /* ----------------------------------------------------------------------------- * Pausing a thread * @@ -255,11 +279,10 @@ threadPaused(Capability *cap, StgTSO *tso) // Note [suspend duplicate work] // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ // If the info table is a WHITEHOLE or a BLACKHOLE, then - // another thread has claimed it (via the SET_INFO() - // below), or is in the process of doing so. In that case - // we want to suspend the work that the current thread has - // done on this thunk and wait until the other thread has - // finished. + // some thread has claimed it, or is in the process of doing + // so. In that case we want to suspend the work that the + // current thread has done on this thunk and wait until the + // other thread has finished. // // If eager blackholing is taking place, it could be the // case that the blackhole points to the current @@ -287,8 +310,8 @@ threadPaused(Capability *cap, StgTSO *tso) // Note that great care is required when entering computations // suspended by this mechanism. See Note [AP_STACKs must be eagerly // blackholed] for details. - if (((bh_info == &stg_BLACKHOLE_info) - && (RELAXED_LOAD(&((StgInd*)bh)->indirectee) != (StgClosure*)tso)) + if ((IS_BLACKHOLE_INFO(bh_info) + && !threadPausedBlackHoleOwner(tso, bh)) || (bh_info == &stg_WHITEHOLE_info)) { debugTrace(DEBUG_squeeze, @@ -318,14 +341,13 @@ threadPaused(Capability *cap, StgTSO *tso) // If we have a frame that is already eagerly blackholed, we // shouldn't overwrite its payload: There may already be a blocking // queue (see #26324). - if(frame_info == &stg_bh_upd_frame_info) { - // eager black hole: we do nothing + if(frame_info == &stg_bh_upd_frame_info + || IS_BLACKHOLE_INFO(bh_info)) { + // already a black hole: we do nothing // it should be a black hole (but we may not own it, as another // thread could have raced us to claim it) - ASSERT(bh_info == &stg_BLACKHOLE_info || - bh_info == &__stg_EAGER_BLACKHOLE_info || - bh_info == &stg_CAF_BLACKHOLE_info); + ASSERT(IS_BLACKHOLE_INFO(bh_info)); } else { // lazy black hole ===================================== rts/Threads.c ===================================== @@ -474,7 +474,7 @@ checkBlockingQueues (Capability *cap, StgTSO *tso) // thing the result would be the same in almost all cases. See #20093. p = UNTAG_CLOSURE(bq->bh); const StgInfoTable *pinfo = ACQUIRE_LOAD(&p->header.info); - if (pinfo != &stg_BLACKHOLE_info || + if (!IS_BLACKHOLE_INFO(pinfo) || (RELAXED_LOAD(&((StgInd *)p)->indirectee) != (StgClosure*)bq)) { wakeBlockingQueue(cap,bq); @@ -498,10 +498,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val) const StgInfoTable *i; i = ACQUIRE_LOAD(&thunk->header.info); - if (i != &stg_BLACKHOLE_info && - i != &stg_CAF_BLACKHOLE_info && - i != &__stg_EAGER_BLACKHOLE_info && - i != &stg_WHITEHOLE_info) { + if (!IS_BLACKHOLE_OR_WHITEHOLE_INFO(i)) { updateWithIndirection(cap, thunk, val); return; } ===================================== rts/Updates.h ===================================== @@ -190,9 +190,9 @@ * frame is encountered, it checks the info table of the updatee and: * * - if it is `BLACKHOLE`, then the thunk has already been claimed for evaluation - * by another thread, and the yielding thread is instead added to the - * `BLACKHOLE`'s blocking queue (see Note [suspend duplicate work] in - * `ThreadPaused.c`). + * by some thread. If that's not the yielding thread itself, the yielding thread + * is added to the `BLACKHOLE`'s blocking queue (see Note [suspend duplicate + * work] in `ThreadPaused.c`). * * - if not, then it blackholes the thunk as done in eager blackholing (but * using the `BLACKHOLE_info` info table instead of `EAGER_BLACKHOLE_info`). ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -382,6 +382,18 @@ EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void ); EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void ) { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection +/* ----------------------------------------------------------------------------- + Blackhole predicates + -------------------------------------------------------------------------- */ + +#define IS_BLACKHOLE_INFO(info) \ + ((info) == &stg_BLACKHOLE_info || \ + (info) == &__stg_EAGER_BLACKHOLE_info || \ + (info) == &stg_CAF_BLACKHOLE_info) + +#define IS_BLACKHOLE_OR_WHITEHOLE_INFO(info) \ + (IS_BLACKHOLE_INFO(info) || (info) == &stg_WHITEHOLE_info) + /* -------------------------------------------------------------------------- Sizes of closures ------------------------------------------------------------------------*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ce5770da1712f0da54665d8755772… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ce5770da1712f0da54665d8755772… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/ghc-internal-def] Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (＠DavidEichmann) 28 May '26

28 May '26

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC Commits: 4f911864 by David Eichmann at 2026-05-28T17:06:55+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll. The correct dll name differs based on if the dll is inplace/final and if using the Dynamic way. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls at runtime in experiments with windows dynamic linking. - - - - - 4 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/win32/libHSghc-internal.def.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Toolchain.Target (Target(tgtArchOs)) import Base import Context +import qualified Data.List as List import Expression hiding (way, package, stage) import Oracles.ModuleFiles import Packages @@ -20,6 +21,7 @@ import Utilities import Data.Time.Clock import Rules.Generate (generatedDependencies) import Oracles.Flag +import Way.Type (wayToUnits) -- * Library 'Rules' @@ -203,13 +205,32 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name. Note that the + -- ghc-internal's .dll.a file is placed in the RTS build dir and not + -- the ghc-internal build dir as we only use it when building the + -- RTS and not other libraries. + ghcInternalDllName <- takeFileName <$> pkgLibraryFile Context { + stage = stage context, + way = rtsWayToLibraryWay (way context), + iplace = iplace context, + package = ghcInternal + } + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] +-- | The rts is compiled in many different ways, but libraries are only built in +-- (non)Dynamic and (non)Profiled ways. This function converts the rts way into +-- compatible library way. +rtsWayToLibraryWay :: Way -> Way +rtsWayToLibraryWay = wayFromUnits . List.intersect [Dynamic, Profiling] . wayToUnits + -- | Return all the object files to be put into the library we're building for -- the given 'Context'. libraryObjects :: Context -> Action [FilePath] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -13,11 +13,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = takeFileName target -<.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = dropExtensions target <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f9118647b8704bce384b679e8cbb8c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f9118647b8704bce384b679e8cbb8c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] Type wobbling
by Wolfgang Jeltsch (＠jeltsch) 28 May '26

28 May '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: d7804631 by Wolfgang Jeltsch at 2026-05-28T18:49:08+03:00 Type wobbling - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -15,7 +16,11 @@ import Data.String (String) import Data.ByteString (ByteString, null, length, unpack) import Numeric (showHex) import System.IO (IO, FilePath) +import GHC.Data.Strict qualified as Strict (maybe) +import GHC.Data.FlatBag (FlatBag) import GHC.Types.SrcLoc (noSrcSpan) +import GHC.Types.Name (Name) +import GHC.Types.SptEntry (SptEntry) import GHC.Types.Error (MessageClass (MCDump)) import GHC.Utils.Logger (Logger, logMsg) import GHC.Utils.Outputable @@ -30,10 +35,12 @@ import GHC.Utils.Outputable withPprStyle, ppr ) -import GHC.ByteCode.Types (CompiledByteCode (..)) +import GHC.ByteCode.Types (UnlinkedBCO, ByteCodeHpcInfo, CompiledByteCode (..)) +import GHC.ByteCode.Breakpoints (InternalModBreaks) import GHC.ByteCode.Binary (OnDiskModuleByteCode (..)) import GHC.ByteCode.Serialize (readOnDiskModuleByteCode) import GHC.Driver.Env.Types (HscEnv) +import GHCi.Message (ConInfoTable) -- | […] showByteCode :: Logger -> HscEnv -> FilePath -> IO () @@ -77,31 +84,31 @@ pprCompiledByteCode CompiledByteCode {..} text "static-pointer table entries:" <+> pprStaticPointerTableEntries bc_spt_entries, text "HPC information:" - <+> pprHPCInfo bc_hpc_info + <+> Strict.maybe (text "<none>") pprHPCInfo bc_hpc_info ] -- | […] -pprByteCodeObjects :: a -> SDoc +pprByteCodeObjects :: FlatBag UnlinkedBCO -> SDoc pprByteCodeObjects = pprByteCodeObjects -- | […] -pprDataConstructorInfoTables :: a -> SDoc +pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc pprDataConstructorInfoTables = pprDataConstructorInfoTables -- | […] -pprTopLevelStrings :: a -> SDoc +pprTopLevelStrings :: [(Name, ByteString)] -> SDoc pprTopLevelStrings = pprTopLevelStrings -- | […] -pprInternalBreakPoints :: a -> SDoc +pprInternalBreakPoints :: InternalModBreaks -> SDoc pprInternalBreakPoints = pprInternalBreakPoints -- | […] -pprStaticPointerTableEntries :: a -> SDoc +pprStaticPointerTableEntries :: [SptEntry] -> SDoc pprStaticPointerTableEntries = pprStaticPointerTableEntries -- | […] -pprHPCInfo :: a -> SDoc +pprHPCInfo :: ByteCodeHpcInfo -> SDoc pprHPCInfo = pprHPCInfo -- | […] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d780463106be003328b9b562790bef9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d780463106be003328b9b562790bef9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/refactor-system-cxx-std-lib-hadrian-rules] 3 commits: hadrian: Refactor system-cxx-std-lib rules
by Sven Tennie (＠supersven) 28 May '26

28 May '26

Sven Tennie pushed to branch wip/supersven/refactor-system-cxx-std-lib-hadrian-rules at Glasgow Haskell Compiler / GHC Commits: af0e71ef by Matthew Pickering at 2026-05-28T15:42:12+02:00 hadrian: Refactor system-cxx-std-lib rules I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules. * For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`. * The `system-cxx-std-lib` dependency is not read from cabal files. * Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`. Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`. Fixes #25303 Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com> - - - - - 1e0695f4 by Sven Tennie at 2026-05-28T15:42:12+02:00 Set shakeVersion This leads to wiping Shake's database, providing backwards compatibility to previous builds with different PackageData. - - - - - a1186a64 by Sven Tennie at 2026-05-28T15:42:12+02:00 Remove superfluous rule - - - - - 6 changed files: - + changelog.d/hadrian-system-cxx-std-lib-25303 - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Main.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs Changes: ===================================== changelog.d/hadrian-system-cxx-std-lib-25303 ===================================== @@ -0,0 +1,18 @@ +section: packaging +synopsis: Fix Hadrian rules for system-cxx-std-lib package dependency +issues: #25303 +mrs: !16013 +description: { + Hadrian's handling of the ``system-cxx-std-lib`` virtual package has been + fixed and made more uniform. + + Previously, ``text`` had an ad-hoc rule outside of ``configurePackage`` to + declare a dependency on ``system-cxx-std-lib``, the dependency was not + discovered from cabal files, and the package database was not recached after + the ``.conf`` file was generated. + + The dependency is now read from cabal files via a new + ``dependsOnSystemCxxStdLib`` field in ``PackageData``, and the ``.conf`` file + is needed inside ``configurePackage`` alongside all other package + dependencies, consistent with how every other package is handled. +} ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -81,10 +81,11 @@ parsePackageData pkg = do sorted = sort [ C.unPackageName p | C.Dependency p _ _ <- allDeps ] deps = nubOrd sorted \\ [name] depPkgs = mapMaybe findPackageByName deps + cxxStdLib = elem "system-cxx-std-lib" deps return $ PackageData name version (C.fromShortText (C.synopsis pd)) (C.fromShortText (C.description pd)) - depPkgs gpd + depPkgs cxxStdLib gpd where -- Collect an overapproximation of dependencies by ignoring conditionals collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency] @@ -138,7 +139,9 @@ configurePackage :: Context -> Action () configurePackage context@Context {..} = do putProgressInfo $ "| Configure package " ++ quote (pkgName package) gpd <- pkgGenericDescription package - depPkgs <- packageDependencies <$> readPackageData package + pd <- readPackageData package + let depPkgs = packageDependencies pd + needSystemCxxStdLib = dependsOnSystemCxxStdLib pd -- Stage packages are those we have in this stage. stagePkgs <- stagePackages stage @@ -157,7 +160,12 @@ configurePackage context@Context {..} = do -- We'll need those packages in our package database. deps <- sequence [ pkgConfFile (context { package = pkg, iplace = forceBaseAfterGhcInternal pkg }) | pkg <- depPkgs, pkg `elem` stagePkgs ] - need $ extraPreConfigureDeps ++ deps + -- system-cxx-std-lib is magic.. it doesn't have a cabal file or source code, so we have + -- to treat it specially as `pkgConfFile` uses `readPackageData` to compute the version. + systemCxxStdLib <- sequence [ systemCxxStdLibConfPath (PackageDbLoc stage iplace) | needSystemCxxStdLib ] + need $ extraPreConfigureDeps + ++ deps + ++ systemCxxStdLib -- Figure out what hooks we need. let configureFile = replaceFileName (pkgCabalFile package) "configure" ===================================== hadrian/src/Hadrian/Haskell/Cabal/Type.hs ===================================== @@ -30,6 +30,7 @@ data PackageData = PackageData , synopsis :: String , description :: String , packageDependencies :: [Package] + , dependsOnSystemCxxStdLib :: Bool , genericPackageDescription :: GenericPackageDescription } deriving (Eq, Generic, Show) ===================================== hadrian/src/Main.hs ===================================== @@ -63,7 +63,13 @@ main = do shakeColor <- shouldUseColor let options :: ShakeOptions options = shakeOptions - { shakeChange = ChangeModtimeAndDigest + { -- Bump shakeVersion whenever a type stored in the Shake oracle + -- changes its Binary representation (e.g. fields added/removed + -- from PackageData or other oracle value types). This forces + -- Shake to wipe the stale database instead of crashing on + -- deserialisation. + shakeVersion = "2" + , shakeChange = ChangeModtimeAndDigest , shakeFiles = buildRoot -/- Base.shakeFilesDir , shakeProgress = Progress.hadrianProgress cwd , shakeRebuild = rebuild ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -242,9 +242,6 @@ copyRules = do prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" - forM_ [Inplace, Final] $ \iplace -> - root -/- relativePackageDbPath (PackageDbLoc stage iplace) -/- systemCxxStdLibConf %> \file -> do - copyFile ("mk" -/- "system-cxx-std-lib-1.0.conf") file generateRules :: Rules () generateRules = do ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -6,7 +6,6 @@ module Rules.Register ( import Base import Context -import Flavour import Oracles.Setting import Hadrian.BuildPath import Hadrian.Expression @@ -48,14 +47,6 @@ configurePackageRules = do isGmp <- (== "gmp") <$> interpretInContext ctx getBignumBackend when isGmp $ need [buildP -/- "include/ghc-gmp.h"] - when (pkg == text) $ do - simdutf <- textWithSIMDUTF <$> flavour - when simdutf $ do - -- This is required, otherwise you get Error: hadrian: - -- Encountered missing or private dependencies: - -- system-cxx-std-lib ==1.0 - cxxStdLib <- systemCxxStdLibConfPath $ PackageDbLoc stage Inplace - need [cxxStdLib] Cabal.configurePackage ctx root -/- "**/autogen/cabal_macros.h" %> \out -> do @@ -105,6 +96,12 @@ registerPackageRules rs stage iplace = do target (Context stage compiler vanilla iplace) (GhcPkg Recache stage) [] [] writeFileLines stamp [] + -- Special rule for registering system-cxx-std-lib + root -/- relativePackageDbPath (PackageDbLoc stage iplace) -/- systemCxxStdLibConf %> \file -> do + copyFile ("mk" -/- "system-cxx-std-lib-1.0.conf") file + buildWithResources rs $ + target (Context stage compiler vanilla iplace) (GhcPkg Recache stage) [] [] + -- Register a package. root -/- relativePackageDbPath (PackageDbLoc stage iplace) -/- "*.conf" %> \conf -> do historyDisable View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f2742f2abece55c7668036d48dee2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f2742f2abece55c7668036d48dee2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] Never modify UnitInfo for better sharing
by Hannes Siebenhandl (＠fendor) 28 May '26

28 May '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 32ebd77d by fendor at 2026-05-28T16:58:16+02:00 Never modify UnitInfo for better sharing - - - - - 4 changed files: - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Unit/State.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC/Driver/Main/Interactive.hs ===================================== @@ -275,7 +275,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -297,7 +297,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -1328,7 +1328,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -1350,7 +1350,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -27,6 +27,9 @@ module GHC.Unit.State ( lookupUnitId, lookupUnitId', unsafeLookupUnitId, + isUnitTrusted, + isUnitIdTrusted, + isUnitInfoTrusted, lookupPackageName, resolvePackageImport, @@ -433,6 +436,9 @@ data UnitState = UnitState { -- may have the 'exposed' flag be 'False'.) unitInfoMap :: UnitInfoMap, + trustedUnits :: Set.Set UnitId, + distrustedUnits :: Set.Set UnitId, + -- | The set of transitively reachable units according -- to the explicitly provided command line arguments. -- A fully instantiated VirtUnit may only be replaced by a RealUnit from @@ -492,6 +498,8 @@ data UnitState = UnitState { emptyUnitState :: UnitState emptyUnitState = UnitState { unitInfoMap = emptyUniqMap, + trustedUnits = Set.empty, + distrustedUnits = Set.empty, preloadClosure = emptyUniqSet, packageNameMap = emptyUFM, wireMap = emptyUniqMap, @@ -624,6 +632,21 @@ mkUnitInfoMap infos = foldl' add emptyUniqMap infos listUnitInfo :: UnitState -> [UnitInfo] listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) +isUnitTrusted :: HasDebugCallStack => UnitState -> Unit -> Bool +isUnitTrusted ue u = + Set.member (toUnitId u) (trustedUnits ue) && (Set.notMember (toUnitId u) (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnit ue u) + +isUnitIdTrusted :: HasDebugCallStack => UnitState -> UnitId -> Bool +isUnitIdTrusted ue u = + Set.member u (trustedUnits ue) && (Set.notMember u (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnitId ue u) + +isUnitInfoTrusted :: HasDebugCallStack => UnitState -> UnitInfo -> Bool +isUnitInfoTrusted ue unit_info = + Set.member (unitId unit_info) (trustedUnits ue) && (Set.notMember (unitId unit_info) (distrustedUnits ue)) + || unitIsTrusted unit_info + -- ---------------------------------------------------------------------------- -- Loading the unit db files and building up the unit state @@ -852,11 +875,6 @@ readUnitDatabase logger cfg conf_file = do else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing -distrustAllUnits :: [UnitInfo] -> [UnitInfo] -distrustAllUnits pkgs = map distrust pkgs - where - distrust pkg = pkg{ unitIsTrusted = False } - mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = @@ -892,22 +910,28 @@ applyTrustFlag :: UnitPrecedenceMap -> UnusableUnits -> [UnitInfo] + -> (Set.Set UnitId, Set.Set UnitId) -> TrustFlag - -> MaybeErr UnitErr [UnitInfo] -applyTrustFlag prec_map unusable pkgs flag = + -> MaybeErr UnitErr (Set.Set UnitId, Set.Set UnitId) +applyTrustFlag prec_map unusable pkgs (trusted, distrusted) flag = case flag of -- we trust all matching packages. Maybe should only trust first one? -- and leave others the same or set them untrusted TrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (map trust ps ++ qs) - where trust p = p {unitIsTrusted=True} + Right (ps,_) -> Succeeded (insertAll ps trusted, removeAll ps distrusted) DistrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (distrustAllUnits ps ++ qs) + Right (ps,_) -> Succeeded (removeAll ps trusted, insertAll ps distrusted) + +insertAll :: [UnitInfo] -> Set UnitId -> Set UnitId +insertAll elements set = foldl' (\ acc -> flip Set.insert acc . unitId) set elements + +removeAll :: [UnitInfo] -> Set UnitId -> Set UnitId +removeAll elements set = foldl' (\ acc -> flip Set.delete acc . unitId) set elements applyPackageFlag :: UnitPrecedenceMap @@ -1547,9 +1571,16 @@ mkUnitState logger cfg = do raw_dbs <- readUnitDatabases logger cfg -- distrust all units if the flag is set - let distrust_all db = db { unitDatabaseUnits = distrustAllUnits (unitDatabaseUnits db) } - dbs | unitConfigDistrustAll cfg = map distrust_all raw_dbs - | otherwise = raw_dbs + let unitsOf db = Set.fromList $ map unitId (unitDatabaseUnits db) + allUnits = Set.unions $ map unitsOf raw_dbs + + distrustedUnits + | unitConfigDistrustAll cfg = allUnits + | otherwise = Set.empty + + trustedUnits = Set.empty + + dbs = raw_dbs -- This, and the other reverse's that you will see, are due to the fact that @@ -1572,11 +1603,12 @@ mkUnitState logger cfg = do reportCycles logger sccs reportUnusable logger unusable - -- Apply trust flags (these flags apply regardless of whether + -- Compute trust flags (these flags apply regardless of whether -- or not packages are visible or not) - pkgs1 <- mayThrowUnitErr - $ foldM (applyTrustFlag prec_map unusable) - (nonDetEltsUniqMap pkg_map2) (reverse (unitConfigFlagsTrusted cfg)) + (trusted, distrusted) <- mayThrowUnitErr + $ foldM (applyTrustFlag prec_map unusable (nonDetEltsUniqMap pkg_map2)) + (trustedUnits, distrustedUnits) (reverse (unitConfigFlagsTrusted cfg)) + let pkgs1 = nonDetEltsUniqMap pkg_map2 let prelim_pkg_db = mkUnitInfoMap pkgs1 -- @@ -1724,6 +1756,8 @@ mkUnitState logger cfg = do , explicitUnits = explicit_pkgs , homeUnitDepends = home_unit_deps , unitInfoMap = pkg_db + , trustedUnits = trusted + , distrustedUnits = distrusted , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet plugin_vis_map @@ -2170,10 +2204,10 @@ pprUnitsWith pprIPI pkgstate = -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) pprUnitsSimple :: UnitState -> SDoc -pprUnitsSimple = pprUnitsWith pprIPI +pprUnitsSimple ue = pprUnitsWith pprIPI ue where pprIPI ipi = let i = unitIdFS (unitId ipi) e = if unitIsExposed ipi then text "E" else text " " - t = if unitIsTrusted ipi then text "T" else text " " + t = if isUnitInfoTrusted ue ipi then text "T" else text " " in e <> t <> text " " <> ftext i -- | Show the mapping of modules to where they come from. ===================================== ghc/GHCi/UI.hs ===================================== @@ -2919,11 +2919,11 @@ isSafeModule m = do packageTrusted hsc_env md | isHomeModule (hsc_home_unit hsc_env) md = True - | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) + | otherwise = isUnitTrusted (hsc_units hsc_env) (moduleUnit md) tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) | otherwise = S.partition part deps - where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg + where part pkg = isUnitIdTrusted unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ebd77d3fcddbcf3c81acec1b4233e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32ebd77d3fcddbcf3c81acec1b4233e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/hadrian-aclocal_path] Hadrian: convert env variable ACLOCAL_PATH to unix paths.
by David Eichmann (＠DavidEichmann) 28 May '26

28 May '26

David Eichmann pushed to branch wip/davide/hadrian-aclocal_path at Glasgow Haskell Compiler / GHC Commits: 1db26f87 by David Eichmann at 2026-05-28T15:06:40+01:00 Hadrian: convert env variable ACLOCAL_PATH to unix paths. Convert ACLOCAL_PATH to a unix style path when invoking autoreconf. Autoreconf doesn't handle windows paths. See Note [Autoreconf unix paths from ACLOCAL_PATH]. Fixes #27311 - - - - - 3 changed files: - boot - hadrian/src/Hadrian/Oracles/Path.hs - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== boot ===================================== @@ -52,9 +52,8 @@ def autoreconf(): # Run autoreconf on everything that needs it. processes = {} if os.name == 'nt': - # Get the normalized ACLOCAL_PATH for Windows - # This is necessary since on Windows this will be a Windows - # path, which autoreconf doesn't know doesn't know how to handle. + # Convert ACLOCAL_PATH env variable to unix style paths on Windows + # See Note [Autoreconf unix paths from ACLOCAL_PATH] ac_local = os.getenv('ACLOCAL_PATH', '') ac_local_arg = re.sub(r';', r':', ac_local) ac_local_arg = re.sub(r'\\', r'/', ac_local_arg) ===================================== hadrian/src/Hadrian/Oracles/Path.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE TypeFamilies #-} module Hadrian.Oracles.Path ( - lookupInPath, fixAbsolutePathOnWindows, pathOracle + lookupInPath, fixAbsolutePathOnWindows, fixUnixPathsOnWindows, + pathOracle ) where import Control.Monad @@ -33,6 +34,14 @@ fixAbsolutePathOnWindows path = else return path +-- | Fix a unix path list on Windows: +-- * "C:\\foo\\bar;C:\\msys2\\bin" => "/c/foo/bar:/c/msys2/bin" +fixUnixPathsOnWindows :: FilePath -> Action FilePath +fixUnixPathsOnWindows paths = + if isWindows + then askOracle $ UnixPathList paths + else return paths + newtype LookupInPath = LookupInPath String deriving (Binary, Eq, Hashable, NFData, Show) type instance RuleResult LookupInPath = String @@ -41,6 +50,10 @@ newtype WindowsPath = WindowsPath FilePath deriving (Binary, Eq, Hashable, NFData, Show) type instance RuleResult WindowsPath = String +newtype UnixPathList = UnixPathList FilePath + deriving (Binary, Eq, Hashable, NFData, Show) +type instance RuleResult UnixPathList = String + -- | Oracles for looking up paths. These are slow and require caching. pathOracle :: Rules () pathOracle = do @@ -50,6 +63,12 @@ pathOracle = do putVerbose $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath return windowsPath + void $ addOracleCache $ \(UnixPathList paths) -> do + Stdout out <- quietly $ cmd ["cygpath", "-p", "-u", paths] + let unixPaths = unifyPath $ dropWhileEnd isSpace out + putVerbose $ "| Unix path mapping: " ++ paths ++ " => " ++ unixPaths + return unixPaths + void $ addOracleCache $ \(LookupInPath name) -> do path <- liftIO getSearchPath exes <- liftIO (findExecutablesInDirectories path name) ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -14,6 +14,7 @@ import qualified System.Directory.Extra as IO import Data.Either import qualified Data.Set as Set import Oracles.Flavour +import Hadrian.Oracles.Path (fixUnixPathsOnWindows) {- Note [Binary distributions] @@ -331,7 +332,25 @@ bindistRules = do ghcRoot <- topDirectory copyFile (ghcRoot -/- "aclocal.m4") (ghcRoot -/- "distrib" -/- "aclocal.m4") copyDirectory (ghcRoot -/- "m4") (ghcRoot -/- "distrib") - buildWithCmdOptions [] $ + + -- Note [Autoreconf unix paths from ACLOCAL_PATH] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -- On windows, autoreconf fails when the ACLOCAL_PATH env variable contains windows + -- style paths. This happens because msys2 automatically converts env variables to + -- windows style paths. To fix this, we convert ACLOCAL_PATH back to unix style. + -- This is done both in the boot phython script and here when building a bindist. + win_host <- isWinHost + env <- if not win_host + then pure [] + else do + aclocalPathMay <- getEnv "ACLOCAL_PATH" + case aclocalPathMay of + Nothing -> pure [] + Just aclocalPath -> do + unixAclocalPath <- fixUnixPathsOnWindows aclocalPath + pure [AddEnv "ACLOCAL_PATH" unixAclocalPath] + + buildWithCmdOptions env $ target (vanillaContext Stage1 ghc) (Autoreconf $ ghcRoot -/- "distrib") [] [] -- We clean after ourselves, moving the configure script we generated in -- our bindist dir View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1db26f87936b4f17802192cc11f31ff… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1db26f87936b4f17802192cc11f31ff… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/directory-bump] libraries/directory: bump submodule to v1.3.11.0
by Magnus (＠MangoIV) 28 May '26

28 May '26

Magnus pushed to branch wip/mangoiv/directory-bump at Glasgow Haskell Compiler / GHC Commits: 95252514 by mangoiv at 2026-05-28T15:22:54+02:00 libraries/directory: bump submodule to v1.3.11.0 Fixes #27312 - - - - - 2 changed files: - + changelog.d/27312 - libraries/directory Changes: ===================================== changelog.d/27312 ===================================== @@ -0,0 +1,7 @@ +section: packaging +issues: #27312 +mrs: !16114 +synopsis: + bump directory submodule to v1.3.11.0 +description: + This submodule bump relaces some version constraints for directory. ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 82d5cfb2c597fa0bb67175c47b682dee1d24ee7a +Subproject commit 12d17af8ee2f84fc6b6ac0d4e1734952789ddd3e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95252514062caacf040cda5e1ca4de7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95252514062caacf040cda5e1ca4de7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/mangoiv/directory-bump
by Magnus (＠MangoIV) 28 May '26

28 May '26

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

1 0

[Git][ghc/ghc][wip/davide/ghc-internal-def] Hadrian: create a ghc-internal .def file per ghc-internal dll
by David Eichmann (＠DavidEichmann) 28 May '26

28 May '26

David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC Commits: d687ebbf by David Eichmann at 2026-05-28T14:14:26+01:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll. The correct dll name differs based on if the dll is inplace/final and if using the Dynamic way. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls at runtime in experiments with windows dynamic linking. - - - - - 4 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Rts.hs - rts/win32/libHSghc-internal.def.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -377,7 +377,6 @@ templateRules = do , interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1 , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 ] - templateRule "rts/win32/libHSghc-internal.def" projectVersion templateRule "docs/index.html" $ packageUnitIds Stage1 templateRule "docs/users_guide/ghc_config.py" $ mconcat [ projectVersion ===================================== hadrian/src/Rules/Library.hs ===================================== @@ -9,6 +9,7 @@ import GHC.Toolchain.Target (Target(tgtArchOs)) import Base import Context +import qualified Data.List as List import Expression hiding (way, package, stage) import Oracles.ModuleFiles import Packages @@ -20,6 +21,7 @@ import Utilities import Data.Time.Clock import Rules.Generate (generatedDependencies) import Oracles.Flag +import Way.Type (wayToUnits) -- * Library 'Rules' @@ -203,13 +205,29 @@ extraObjects context | package context == rts = do target <- interpretInContext context getStagedTarget - builddir <- buildPath context - return [ builddir -/- "libHSghc-internal.dll.a" - | archOS_OS (tgtArchOs target) == OSMinGW32 - , Dynamic `wayUnit` way context ] + if not (archOS_OS (tgtArchOs target) == OSMinGW32 + && Dynamic `wayUnit` way context) + then return [] + else do + -- Find the ghc-internal library file name + ghcInternalDllName <- takeFileName <$> pkgLibraryFile Context { + stage = stage context, + way = rtsWayToLibraryWay (way context), + iplace = iplace context, + package = ghcInternal + } + + builddir <- buildPath context + return [ builddir -/- ghcInternalDllName <> ".a"] | otherwise = return [] +-- | The rts is compiled in many different ways, but libraries are only built in +-- (non)Dynamic and (non)Profiled ways. This function converts the rts way into +-- compatible library way. +rtsWayToLibraryWay :: Way -> Way +rtsWayToLibraryWay = wayFromUnits . List.intersect [Dynamic, Profiling] . wayToUnits + -- | Return all the object files to be put into the library we're building for -- the given 'Context'. libraryObjects :: Context -> Action [FilePath] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -13,11 +13,19 @@ rtsRules = priority 3 $ do -- to be linked into the rts dll. forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) - buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib + buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef + buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib + +buildGhcInternalImportDef :: FilePath -> Action () +buildGhcInternalImportDef target = do + templateIn <- readFile' "rts/win32/libHSghc-internal.def.in" + let dllName = takeFileName target -<.> "dll" + templateOut = replace "@GhcInternalDll@" dllName templateIn + writeFile' target templateOut buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = "rts/win32/libHSghc-internal.def" + let input = dropExtensions target <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== rts/win32/libHSghc-internal.def.in ===================================== @@ -1,4 +1,4 @@ -LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll +LIBRARY @GhcInternalDll@ EXPORTS init_ghc_hs_iface View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d687ebbf20c5b4b0ed4401d26bc6096… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d687ebbf20c5b4b0ed4401d26bc6096… You're receiving this email because of your account on gitlab.haskell.org.

1 0