Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL at Glasgow Haskell Compiler / GHC Commits: 51ad7c99 by Sven Tennie at 2026-01-11T20:17:52+01:00 WIP: Dirty hack Let Stage0 build with the default.host.target file and decide for other stages if default.target cannot be used. Acutally, I don't like this logic on this level. - - - - - 8 changed files: - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -124,8 +124,8 @@ getBuildTarget :: Action Toolchain.Target getBuildTarget = getTargetConfig buildTargetFile -- | Get the host target configuration through 'getTargetConfig' -getHostTarget :: Action Toolchain.Target -getHostTarget = do +getHostTarget :: Stage -> Action Toolchain.Target +getHostTarget stage | stage >= Stage1 = do -- MP: If we are not cross compiling then we should use the target file in order to -- build things for the host, in particular we want to use the configured values for the -- target for building the RTS (ie are we using Libffi for adjustors, and the wordsize) @@ -135,8 +135,7 @@ getHostTarget = do if (Toolchain.targetPlatformTriple ht) == (Toolchain.targetPlatformTriple tt) then return tt else return ht - -- where - -- msg = "The host's target configuration file " ++ quote hostTargetFile ++ " does not exist! ghc-toolchain might have failed to generate it." +getHostTarget _stage {- stage0 -} = getTargetConfig hostTargetFile -- | Get the target target configuration through 'getTargetConfig' getTargetTarget :: Action Toolchain.Target @@ -145,9 +144,8 @@ getTargetTarget = getTargetConfig targetTargetFile queryBuildTarget :: (Toolchain.Target -> a) -> Action a queryBuildTarget f = f <$> getBuildTarget -queryHostTarget :: (Toolchain.Target -> a) -> Action a -queryHostTarget f = f <$> getHostTarget - +queryHostTarget :: Stage -> (Toolchain.Target -> a) -> Action a +queryHostTarget stage f = f <$> getHostTarget stage newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show) ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -137,7 +137,7 @@ getSetting = expr . setting bashPath :: Action FilePath bashPath = setting BourneShell -isWinHost :: Action Bool +isWinHost :: Stage -> Action Bool isWinHost = anyHostOs [OSMinGW32] isWinTarget :: Stage -> Action Bool @@ -153,8 +153,8 @@ isArmTarget :: Stage -> Action Bool isArmTarget stage = queryTargetTarget stage (isARM . archOS_arch . tgtArchOs) -- | Check whether the host OS setting matches one of the given strings. -anyHostOs :: [OS] -> Action Bool -anyHostOs oss = (`elem` oss) <$> queryHostTarget (archOS_OS . tgtArchOs) +anyHostOs :: [OS] -> Stage -> Action Bool +anyHostOs oss stage = (`elem` oss) <$> queryHostTarget stage (archOS_OS . tgtArchOs) -- | Check whether the target architecture setting matches one of the given -- strings. @@ -233,7 +233,7 @@ libsuf st way -- For example, we want to build RTS with stage1 for the host target as we -- produce a host executable with stage1 (which cross-compiles to stage2). targetStage :: Stage -> Action Target -targetStage stage | isHostStage stage = getHostTarget +targetStage stage | isHostStage stage = getHostTarget stage targetStage _ = getTargetTarget isHostStage :: Stage -> Bool ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -326,7 +326,7 @@ bindistRules = do -- phony "binary-dist-dir-stage3" $ buildBinDistDir root targetBindist let buildBinDist compressor = do - win_host <- isWinHost + win_host <- isWinHost Stage1 win_target <- isWinTarget Stage2 when (win_target && win_host) (error "normal binary-dist does not work for windows targets, use `reloc-binary-dist-*` target instead.") buildBinDistX "binary-dist-dir" "bindist" compressor ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -409,7 +409,7 @@ bindistRules = do , interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2 , interpolateSetting "ProjectGitCommitId" ProjectGitCommitId - , interpolateVar "HostOS_CPP" $ fmap cppify $ interp $ queryHost queryOS + , interpolateVar "HostOS_CPP" $ fmap cppify $ interp $ queryHost queryOS Stage1 , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple , interpolateVar "TargetPlatform_CPP" $ cppify <$> getTarget targetPlatformTriple @@ -433,7 +433,7 @@ bindistRules = do , interpolateVar "TargetHasLibm" $ yesNo <$> interp (staged (buildFlag TargetHasLibm)) , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple , interpolateVar "BuildPlatform" $ interp $ queryBuild targetPlatformTriple - , interpolateVar "HostPlatform" $ interp $ queryHost targetPlatformTriple + , interpolateVar "HostPlatform" $ interp $ queryHost targetPlatformTriple Stage1 , interpolateVar "TargetWordBigEndian" $ getTarget isBigEndian , interpolateVar "TargetWordSize" $ getTarget wordSize , interpolateVar "Unregisterised" $ yesNo <$> getTarget tgtUnregisterised @@ -523,7 +523,7 @@ generateConfigHs = do let chooseSetting x y = case stage of { Stage0 {} -> x; _ -> y } let queryTarget f = f <$> expr (targetStage stage) -- Not right for stage3 - buildPlatform <- chooseSetting (queryBuild targetPlatformTriple) (queryHost targetPlatformTriple) + buildPlatform <- chooseSetting (queryBuild targetPlatformTriple) (queryHost targetPlatformTriple stage) hostPlatform <- queryTarget targetPlatformTriple trackGenerateHs cProjectName <- getSetting ProjectName @@ -626,9 +626,9 @@ generatePlatformHostHs = do stage <- getStage let chooseHostQuery = case stage of Stage0 {} -> queryHost - _ -> queryTarget stage - cHostPlatformArch <- chooseHostQuery (archOS_arch . tgtArchOs) - cHostPlatformOS <- chooseHostQuery (archOS_OS . tgtArchOs) + _ -> flip queryTarget + cHostPlatformArch <- chooseHostQuery (archOS_arch . tgtArchOs) stage + cHostPlatformOS <- chooseHostQuery (archOS_OS . tgtArchOs) stage return $ unlines [ "module GHC.Platform.Host where" , "" ===================================== hadrian/src/Rules/Lint.hs ===================================== @@ -42,7 +42,7 @@ runHLint :: [FilePath] -- ^ include directories -> Action () runHLint includeDirs defines dir = do threads <- shakeThreads <$> getShakeOptions - hostArch <- (<> "_HOST_ARCH") <$> queryHostTarget queryArch + hostArch <- (<> "_HOST_ARCH") <$> queryHostTarget Stage1 queryArch let hlintYaml = dir ".hlint.yaml" defines' = hostArch : defines cmdLine = unwords $ ===================================== hadrian/src/Settings.hs ===================================== @@ -119,9 +119,11 @@ unsafeFindPackageByPath path = err $ find (\pkg -> pkgPath pkg == path) knownPac -- Be careful querying values from the HOST and BUILD targets until the targets -- are only generated by ghc-toolchain: -- See Note [The dummy values in the HOST target description] -queryBuild, queryHost :: (Target -> a) -> Expr a +queryBuild :: (Target -> a) -> Expr a queryBuild f = expr $ queryBuildTarget f -queryHost f = expr $ queryHostTarget f + +queryHost :: (Target -> a) -> Stage -> Expr a +queryHost f stage = expr $ queryHostTarget stage f queryArch, queryOS, queryVendor :: Target -> String queryArch = stringEncodeArch . archOS_arch . tgtArchOs ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -13,8 +13,8 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do ccPath <- getBuilderPath $ Cc CompileC stage gmpDir <- staged (buildSetting GmpIncludeDir) top <- expr topDirectory - hArch <- queryHost queryArch - hOs <- queryHost queryOS + hArch <- queryHost queryArch stage + hOs <- queryHost queryOS stage tArch <- queryTarget stage queryArch tOs <- queryTarget stage queryOS version <- case stage of ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -124,7 +124,7 @@ inTreeCompilerArgs stg = do debugged <- ghcDebugged <$> flavour <*> pure ghcStage profiled <- ghcProfiled <$> flavour <*> pure ghcStage - os <- queryHostTarget queryOS + os <- queryHostTarget ghcStage queryOS arch <- queryTargetTarget ghcStage queryArch let codegen_arches = ["x86_64", "i386", "powerpc", "powerpc64", "powerpc64le", "aarch64", "wasm32", "riscv64", "loongarch64"] let withNativeCodeGen View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51ad7c997c1c36db4727d4f3b8a2c738... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51ad7c997c1c36db4727d4f3b8a2c738... You're receiving this email because of your account on gitlab.haskell.org.