Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 323acc1a by GHC GitLab CI at 2026-07-25T07:52:51+02:00 WIP cleanup - - - - - b308f51a by GHC GitLab CI at 2026-07-25T08:48:21+02:00 WIP - - - - - ef1aa88d by GHC GitLab CI at 2026-07-25T09:14:18+02:00 formatting - - - - - 406a8862 by GHC GitLab CI at 2026-07-25T09:57:35+02:00 Simplify generateSettings - - - - - 57ca7ca3 by GHC GitLab CI at 2026-07-25T15:16:50+02:00 Simplify - - - - - 2 changed files: - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -253,9 +253,9 @@ buildBinDistDir root conf@BindistConfig{..} = do -- relocatable. The package DB is always at "package.conf.d" relative to -- the lib dir, matching the known bindist layout. let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" - bindistContext = vanillaContext library_stage compiler + bindistContext = vanillaContext executable_stage compiler bindistSettingsContent <- interpretInContext bindistContext $ - generateSettings bindistSettings False "package.conf.d" executable_stage + generateSettings bindistSettings False "package.conf.d" library_stage writeFile' bindistSettings bindistSettingsContent copyDirectory rtsIncludeDir bindistFilesDir ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -252,32 +252,51 @@ generateRules = do (root -/- "ghc-stage2") <~+ ghcWrapper Stage2 (root -/- "ghc-stage3") <~+ ghcWrapper Stage3 - forM_ allStages $ \stage -> do - let prefix = root -/- stageString stage -/- "lib" - -- For the finalStage, we generate settings for that stage. For - -- others we look at the next stage. Why? Because cross-compilers - -- require libs from the successor stage, otherwise they are - -- compiled for the host and not the target. - stage' = if stage /= finalStage then succStage stage else stage - go gen file = generate file (semiEmptyTarget stage') gen + forM_ allStages $ \buildStage -> do + let -- Two stages are in play per rule iteration: + -- + -- * @buildStage@ — loop variable; the settings file is written + -- into @_build/<buildStage>/lib/settings@ and + -- describes the compiler at @compilerStage@. + -- * @compilerStage@ — the stage whose @bin/@ holds the compiler + -- the settings file describes; also the + -- ambient 'Expr' stage passed to + -- 'generateSettings' (via 'semiEmptyTarget'), + -- so it is the value of @executableStage@ + -- inside that function. + -- + -- For a cross-compiler the libs it links against live in the + -- /successor/ stage's lib dir; @libraryStage@ (computed in the + -- rule body below) is that successor. @compilerStage@ normally + -- equals @buildStage@, but at @finalStage@ there is no successor + -- to hold its libs, so @compilerStage@ drops to the predecessor + -- (the final stage's lib dir merely hosts the predecessor + -- cross-compiler's target-arch libs). + compilerStage = if buildStage == finalStage + then predStage buildStage + else buildStage + prefix = root -/- stageString buildStage -/- "lib" + go gen file = generate file (semiEmptyTarget compilerStage) gen (prefix -/- "settings") %> \out -> do - let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) - -- For cross, LibDir points to stage' lib dir, so pkgDb must also - -- be relative to stage' lib dir. - isCross <- crossStage stage - let libStage = case stage of + -- Stage0 has no library or package DB of its own (the + -- bootstrapping compiler uses Stage1's); for any other stage the + -- package DB lives where the LibDir redirect points (this stage's + -- own lib dir, or the successor's when @buildStage@ is a cross + -- stage). + isCross <- crossStage buildStage + let libraryStage = case buildStage of Stage0 {} -> Stage1 - _ -> if isCross then stage' else stage - pkgDb <- get_pkg_db libStage + _ -> if isCross then succStage buildStage else buildStage + pkgDb <- packageDbPath (PackageDbLoc libraryStage Final) -- addTrailingPathSeparator needed: makeRelativeNoSysLink uses -- splitPath where "lib" and "lib/" are distinct components. let libTopDir = addTrailingPathSeparator $ - if isCross - then root -/- stageString stage' -/- "lib" - else prefix + if isStage0 buildStage + then prefix + else root -/- stageString libraryStage -/- "lib" relPkgDb = makeRelativeNoSysLink libTopDir pkgDb - go (generateSettings out True relPkgDb (predStage stage')) out - (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage stage))) out + go (generateSettings out True relPkgDb libraryStage) out + (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr (targetStage (succStage buildStage))) out where file <~+ gen = file %> \out -> generate out emptyTarget gen >> makeExecutable out @@ -557,42 +576,31 @@ ghcWrapper stage = do -- | Generate settings file, optionally including @LibDir@. -- +-- Describes the compiler whose stage is the ambient 'Expr' context +-- (available here as @executableStage@ via 'getStage'). The @libraryStage@ +-- argument is the stage whose lib dir holds the libraries the described +-- compiler links against — used both for the @base@ unit-id lookup and for +-- the @LibDir@ entry. It usually equals @executableStage@ but differs when +-- the compiler links against libraries from a different stage (cross +-- compilers, or the Stage0 bootstrap compiler using Stage1's libraries). +-- -- @rel_pkg_db@: package DB path relative to the lib dir (e.g. -- "package.conf.d"). Callers supply the correct relative path. For bindists --- the layout is known statically; for in-tree builds callers compute it. For --- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. +-- the layout is known statically; for in-tree builds callers compute it. +-- For bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. generateSettings :: FilePath -> Bool -> FilePath -> Stage -> Expr String -generateSettings settingsFile includeLibDir rel_pkg_db compilerStage = do +generateSettings settingsFile includeLibDir rel_pkg_db libraryStage = do ctx <- getContext - stage <- getStage + executableStage <- getStage + + base_unit_id <- expr $ pkgUnitId libraryStage base - -- The unit-id of the base package which is always linked against (#25382). - -- For stage2 cross compilers the target libraries live in the stage3 lib - -- dir, so the base unit-id must come from stage2; for native stage2 the - -- libraries live in the stage1 lib dir. - base_unit_id <- expr $ do - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> pkgUnitId Stage1 base - Stage2 -> do - isCross <- crossStage compilerStage - pkgUnitId (if isCross then stage else compilerStage) base - Stage3 -> pkgUnitId Stage2 base - - -- For cross compilers, LibDir points to the succeeding stage's lib dir - -- (which contains the target architecture's libraries). For non-cross, - -- it points to the preceding stage's lib dir as usual. - isCrossLibDir <- expr $ crossStage compilerStage - let stage_dir_stage = if isCrossLibDir then stage else compilerStage - - -- addTrailingPathSeparator is needed because makeRelativeNoSysLink uses - -- splitPath internally, where "lib" and "lib/" are distinct components. - lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath stage_dir_stage + lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath libraryStage let rel_lib_topDir = makeRelativeNoSysLink (dropFileName settingsFile) lib_topDir settings <- traverse sequence $ - [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit, Context.stage = compilerStage }))) - , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter compilerStage) + [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter executableStage) -- Hard-coded as Cabal queries these to determine way support and we -- need to always advertise all ways when bootstrapping. -- The settings file is generated at install time when installing a bindist. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ec8857ce2bfb35b175fa1f88da5790... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ec8857ce2bfb35b175fa1f88da5790... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help