Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC
Commits:
-
0b73a45a
by Sven Tennie at 2025-09-20T20:41:30+02:00
7 changed files:
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Libffi.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Packages.hs
Changes:
| ... | ... | @@ -241,7 +241,7 @@ instance H.Builder Builder where |
| 241 | 241 | distro_mingw <- lookupStageBuildConfig "settings-use-distro-mingw" st
|
| 242 | 242 | -- TODO: Check this is the right stage
|
| 243 | 243 | libffi_adjustors <- targetUseLibffiForAdjustors st
|
| 244 | - use_system_ffi <- buildFlag UseSystemFfi st
|
|
| 244 | + use_system_ffi <- buildFlag UseSystemFfi (succStage st)
|
|
| 245 | 245 | |
| 246 | 246 | return $ [ unlitPath ]
|
| 247 | 247 | ++ [ root -/- mingwStamp | windowsHost, distro_mingw == "NO" ]
|
| ... | ... | @@ -3,7 +3,7 @@ module Context ( |
| 3 | 3 | Context (..), vanillaContext, stageContext,
|
| 4 | 4 | |
| 5 | 5 | -- * Expressions
|
| 6 | - getStage, staged, getPackage, getWay, getBuildPath, getHieBuildPath, getPackageDbLoc, getStagedTarget,
|
|
| 6 | + getStage, staged, succStaged, getPackage, getWay, getBuildPath, getHieBuildPath, getPackageDbLoc, getStagedTarget,
|
|
| 7 | 7 | |
| 8 | 8 | -- * Paths
|
| 9 | 9 | contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
|
| ... | ... | @@ -32,6 +32,9 @@ getStage = stage <$> getContext |
| 32 | 32 | staged :: (Stage -> Action a) -> Expr Context b a
|
| 33 | 33 | staged f = getStage >>= \stage -> expr (f stage)
|
| 34 | 34 | |
| 35 | +succStaged :: (Stage -> Action a) -> Expr Context b a
|
|
| 36 | +succStaged f = getStage >>= \stage -> expr (f (succStage stage))
|
|
| 37 | + |
|
| 35 | 38 | getInplace :: Expr Context b Inplace
|
| 36 | 39 | getInplace = iplace <$> getContext
|
| 37 | 40 |
| ... | ... | @@ -55,7 +55,7 @@ rtsDependencies :: Expr [FilePath] |
| 55 | 55 | rtsDependencies = do
|
| 56 | 56 | rtsPath <- staged rtsBuildPath
|
| 57 | 57 | jsTarget <- staged isJsTarget
|
| 58 | - useSystemFfi <- staged (buildFlag UseSystemFfi)
|
|
| 58 | + useSystemFfi <- succStaged (buildFlag UseSystemFfi)
|
|
| 59 | 59 | |
| 60 | 60 | let -- headers common to native and JS RTS
|
| 61 | 61 | common_headers =
|
| ... | ... | @@ -69,7 +69,7 @@ dynLibManifest = dynLibManifest' buildRoot |
| 69 | 69 | -- | Need the (locally built) libffi library.
|
| 70 | 70 | needLibffi :: Stage -> Action ()
|
| 71 | 71 | needLibffi stage = do
|
| 72 | - jsTarget <- isJsTarget stage
|
|
| 72 | + jsTarget <- isJsTarget (succStage stage)
|
|
| 73 | 73 | unless jsTarget $ do
|
| 74 | 74 | manifest <- dynLibManifest stage
|
| 75 | 75 | need [manifest]
|
| ... | ... | @@ -87,7 +87,7 @@ libffiContext stage = do |
| 87 | 87 | -- | The name of the library
|
| 88 | 88 | libffiName :: Expr String
|
| 89 | 89 | libffiName = do
|
| 90 | - useSystemFfi <- staged (buildFlag UseSystemFfi)
|
|
| 90 | + useSystemFfi <- succStaged (buildFlag UseSystemFfi)
|
|
| 91 | 91 | if useSystemFfi
|
| 92 | 92 | then pure "ffi"
|
| 93 | 93 | else libffiLocalName Nothing
|
| ... | ... | @@ -159,7 +159,7 @@ libffiRules :: Rules () |
| 159 | 159 | libffiRules = do
|
| 160 | 160 | _ <- addOracleCache $ \ (LibffiDynLibs stage)
|
| 161 | 161 | -> do
|
| 162 | - jsTarget <- isJsTarget stage
|
|
| 162 | + jsTarget <- isJsTarget (succStage stage)
|
|
| 163 | 163 | if jsTarget
|
| 164 | 164 | then return []
|
| 165 | 165 | else readFileLines =<< dynLibManifest stage
|
| ... | ... | @@ -33,7 +33,7 @@ rtsRules = priority 3 $ do |
| 33 | 33 | -- Header files
|
| 34 | 34 | -- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
|
| 35 | 35 | forM_ libffiHeaderFiles $ \header ->
|
| 36 | - buildPath -/- "include" -/- header %> copyLibffiHeader stage
|
|
| 36 | + buildPath -/- "include" -/- header %> copyLibffiHeader (succStage stage)
|
|
| 37 | 37 | |
| 38 | 38 | -- Static libraries.
|
| 39 | 39 | buildPath -/- "libCffi*.a" %> copyLibffiStatic stage
|
| ... | ... | @@ -54,7 +54,7 @@ withLibffi stage action = needLibffi stage |
| 54 | 54 | -- See Note [Packaging libffi headers] in GHC.Driver.CodeOutput.
|
| 55 | 55 | copyLibffiHeader :: Stage -> FilePath -> Action ()
|
| 56 | 56 | copyLibffiHeader stage header = do
|
| 57 | - useSystemFfi <- buildFlag UseSystemFfi stage
|
|
| 57 | + useSystemFfi <- buildFlag UseSystemFfi (succStage stage)
|
|
| 58 | 58 | (fromStr, headerDir) <- if useSystemFfi
|
| 59 | 59 | then ("system",) <$> libffiSystemHeaderDir stage
|
| 60 | 60 | else needLibffi stage
|
| ... | ... | @@ -129,7 +129,7 @@ rtsLibffiLibrary stage way = do |
| 129 | 129 | needRtsLibffiTargets :: Stage -> Action [FilePath]
|
| 130 | 130 | needRtsLibffiTargets stage = do
|
| 131 | 131 | rtsPath <- rtsBuildPath stage
|
| 132 | - useSystemFfi <- buildFlag UseSystemFfi stage
|
|
| 132 | + useSystemFfi <- buildFlag UseSystemFfi (succStage stage)
|
|
| 133 | 133 | jsTarget <- isJsTarget stage
|
| 134 | 134 | |
| 135 | 135 | -- Header files (in the rts build dir).
|
| ... | ... | @@ -107,7 +107,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do |
| 107 | 107 | context <- getContext
|
| 108 | 108 | distPath <- expr (Context.distDynDir context)
|
| 109 | 109 | |
| 110 | - useSystemFfi <- staged (buildFlag UseSystemFfi)
|
|
| 110 | + useSystemFfi <- succStaged (buildFlag UseSystemFfi)
|
|
| 111 | 111 | buildPath <- getBuildPath
|
| 112 | 112 | libffiName' <- libffiName
|
| 113 | 113 | debugged <- buildingCompilerStage' . ghcDebugged =<< expr flavour
|
| ... | ... | @@ -298,7 +298,7 @@ rtsPackageArgs = package rts ? do |
| 298 | 298 | way <- getWay
|
| 299 | 299 | path <- getBuildPath
|
| 300 | 300 | top <- expr topDirectory
|
| 301 | - useSystemFfi <- staged (buildFlag UseSystemFfi)
|
|
| 301 | + useSystemFfi <- succStaged (buildFlag UseSystemFfi)
|
|
| 302 | 302 | ffiIncludeDir <- staged (buildSetting FfiIncludeDir)
|
| 303 | 303 | ffiLibraryDir <- staged (buildSetting FfiLibDir)
|
| 304 | 304 | libdwIncludeDir <- staged (\s -> queryTargetTarget s (Lib.includePath <=< tgtRTSWithLibdw))
|