[Git][ghc/ghc][wip/toolchain-selection] 2 commits: ROMES: WIP 3
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon May 15 17:49:13 UTC 2023
Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC
Commits:
3ffeaa32 by Rodrigo Mesquita at 2023-05-15T18:27:37+01:00
ROMES: WIP 3
- - - - -
f83f08a9 by Rodrigo Mesquita at 2023-05-15T18:28:50+01:00
Delete CMD_OPTS_STAGEX
Instead of having configure configure different options for different
programs depend on the stage, we delete this completely and have hadrian
select the correct target toolchain configuration file depending on the
stage, from which it can read those options.
- - - - -
18 changed files:
- hadrian/cfg/system.config.in
- hadrian/src/Context.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Oracles/TextFile.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Rules/Libffi.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Cc.hs
- hadrian/src/Settings/Builders/DeriveConstants.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/HsCpp.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- hadrian/src/Settings/Builders/Ld.hs
- hadrian/src/Settings/Builders/MergeObjects.hs
- m4/fptools_set_haskell_platform_vars.m4
Changes:
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -49,20 +49,30 @@ leading-underscore = @LeadingUnderscore@
# Information about build, host and target systems:
#==================================================
+# ROMES:TODO: Deal with vendor
+
build-platform = @BuildPlatform@
+
build-arch = @BuildArch_CPP@
build-os = @BuildOS_CPP@
+
build-vendor = @BuildVendor_CPP@
host-platform = @HostPlatform@
+
+# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name.
host-arch = @HostArch_CPP@
host-os = @HostOS_CPP@
+
host-vendor = @HostVendor_CPP@
target-platform = @TargetPlatform@
target-platform-full = @TargetPlatformFull@
+
+# ROMES:TODO: These will be computed from the function in ghc-toolchain mapped from the Haskell constructor name.
target-arch = @TargetArch_CPP@
target-os = @TargetOS_CPP@
+
target-vendor = @TargetVendor_CPP@
llvm-target = @LLVMTarget_CPP@
@@ -75,7 +85,7 @@ ghc-major-version = @GhcMajVersion@
ghc-minor-version = @GhcMinVersion@
ghc-patch-level = @GhcPatchLevel@
-bootstrap-threaded-rts = @GhcThreadedRts@
+bootstrap-threaded-rts = @GhcThreadedRts@
project-name = @ProjectName@
project-version = @ProjectVersion@
@@ -86,35 +96,6 @@ project-patch-level1 = @ProjectPatchLevel1@
project-patch-level2 = @ProjectPatchLevel2@
project-git-commit-id = @ProjectGitCommitId@
-# Compilation and linking flags:
-#===============================
-
-conf-cc-args-stage0 = @CONF_CC_OPTS_STAGE0@
-conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@
-conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@
-conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@
-
-conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@
-conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@
-conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@
-conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@
-
-conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@
-conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@
-conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@
-conf-gcc-linker-args-stage3 = @CONF_GCC_LINKER_OPTS_STAGE3@
-
-conf-ld-linker-args-stage0 = @CONF_LD_LINKER_OPTS_STAGE0@
-conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@
-conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@
-conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@
-
-conf-merge-objects-args-stage0 = @MergeObjsArgs@
-conf-merge-objects-args-stage1 = @MergeObjsArgs@
-conf-merge-objects-args-stage2 = @MergeObjsArgs@
-conf-merge-objects-args-stage3 = @MergeObjsArgs@
-
-
# Settings:
#==========
@@ -126,6 +107,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@
gcc-extra-via-c-opts = @GccExtraViaCOpts@
ld-is-gnu-ld = @LdIsGNULd@
+# ROMES:TODO: Drop almost every of these from settings.
settings-c-compiler-command = @SettingsCCompilerCommand@
settings-cxx-compiler-command = @SettingsCxxCompilerCommand@
settings-haskell-cpp-command = @SettingsHaskellCPPCommand@
=====================================
hadrian/src/Context.hs
=====================================
@@ -3,7 +3,7 @@ module Context (
Context (..), vanillaContext, stageContext,
-- * Expressions
- getStage, getPackage, getWay, getStagedSettingList, getBuildPath, getPackageDbLoc,
+ getStage, getPackage, getWay, getBuildPath, getPackageDbLoc, getStagedTargetConfig,
-- * Paths
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
@@ -19,6 +19,7 @@ import Context.Type
import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting
+import GHC.Toolchain.Target (Target)
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
@@ -47,9 +48,9 @@ getPackage = package <$> getContext
getWay :: Expr Context b Way
getWay = way <$> getContext
--- | Get a list of configuration settings for the current stage.
-getStagedSettingList :: (Stage -> SettingList) -> Args Context b
-getStagedSettingList f = getSettingList . f =<< getStage
+-- | Get the 'Target' configuration of the current stage
+getStagedTargetConfig :: Expr Context b Target
+getStagedTargetConfig = expr . targetConfigStage =<< getStage
-- | Path to the directory containing the final artifact in a given 'Context'.
libPath :: Context -> Action FilePath
@@ -95,7 +96,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
-- | Path to the haddock file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/doc/html/array/array.haddock at .
pkgHaddockFile :: Context -> Action FilePath
-pkgHaddockFile context at Context {..} = do
+pkgHaddockFile Context {..} = do
root <- buildRoot
version <- pkgUnitId stage package
return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
@@ -136,7 +137,7 @@ pkgGhciLibraryFile context at Context {..} = do
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
-pkgConfFile context at Context {..} = do
+pkgConfFile Context {..} = do
pid <- pkgUnitId stage package
dbPath <- packageDbPath (PackageDbLoc stage iplace)
return $ dbPath -/- pid <.> "conf"
=====================================
hadrian/src/Hadrian/Haskell/Hash.hs
=====================================
@@ -31,7 +31,6 @@ import Way
import Packages
import Development.Shake.Classes
import Control.Monad
-import Utilities
import Base
import Context
import System.Directory.Extra (listFilesRecursive)
=====================================
hadrian/src/Hadrian/Oracles/TextFile.hs
=====================================
@@ -91,6 +91,7 @@ getTargetConfig :: FilePath -> Action Toolchain.Target
getTargetConfig file = askOracle $ TargetFile file
-- | Get the host's target configuration through 'getTarget'
+-- ROMES:TODO: Rename HOST to BUILD
getHostTargetConfig :: Action Toolchain.Target
getHostTargetConfig = getTargetConfig hostTargetFile
-- where
@@ -163,5 +164,5 @@ instance Hashable Toolchain.Target where
hashWithSalt s = hashWithSalt s . show
instance NFData Toolchain.Target where
- rnf = flip seq () -- ROMES:TODO: Is this a good enough instance?
+ rnf = flip seq () -- ROMES:TODO: Would be better to do this well, but it isn't easy to make instances for Target
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -1,13 +1,12 @@
module Oracles.Setting (
configFile,
-- * Settings
- Setting (..), SettingList (..), setting, settingList, getSetting,
- getSettingList,
+ Setting (..), setting, getSetting,
ToolchainSetting (..), settingsFileSetting,
-- * Helpers
ghcCanonVersion, cmdLineLengthLimit, hostSupportsRPaths, topDirectory,
- libsuf, ghcVersionStage, bashPath,
+ libsuf, ghcVersionStage, bashPath, targetConfigStage,
-- ** Target platform things
anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
@@ -85,23 +84,6 @@ data Setting = BuildArch
| TargetWordSize
| BourneShell
--- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
--- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,
--- generated by the @configure@ script from the input file
--- @hadrian/cfg/system.config.in at . For example, the line
---
--- > hs-cpp-args = -E -undef -traditional
---
--- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up
--- the value of the setting and returns the list of strings
--- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database.
-data SettingList = ConfCcArgs Stage
- | ConfCppArgs Stage
- | ConfGccLinkerArgs Stage
- | ConfLdLinkerArgs Stage
- | ConfMergeObjectsArgs Stage
- | HsCppArgs
-
-- TODO compute solely in Hadrian, removing these variables' definitions
-- from aclocal.m4 whenever they can be calculated from other variables
-- already fed into Hadrian.
@@ -135,6 +117,8 @@ data ToolchainSetting
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
-- result.
+-- ROMES:TODO: Things that are gotten from the toolchain configs will no longer
+-- be part of settings, so they should be moved out
setting :: Setting -> Action String
setting key = case key of
BuildArch -> systemConf "build-arch"
@@ -153,7 +137,6 @@ setting key = case key of
GhcSourcePath -> systemConf "ghc-source-path"
GmpIncludeDir -> systemConf "gmp-include-dir"
GmpLibDir -> systemConf "gmp-lib-dir"
- -- ROMES:TODO: What's the difference between hostArch and hostArchHaskell?
HostArch -> systemConf "host-arch"
HostOs -> systemConf "host-os"
HostPlatform -> systemConf "host-platform"
@@ -193,21 +176,6 @@ setting key = case key of
archStr = stringEncodeArch . archOS_arch . tgtArchOs
osStr = stringEncodeOS . archOS_OS . tgtArchOs
-bootIsStage0 :: Stage -> Stage
-bootIsStage0 (Stage0 {}) = Stage0 InTreeLibs
-bootIsStage0 s = s
-
--- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
--- result.
-settingList :: SettingList -> Action [String]
-settingList key = fmap words $ lookupSystemConfig $ case key of
- ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage)
- ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage)
- ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage)
- ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage)
- ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage)
- HsCppArgs -> "hs-cpp-args"
-
-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
-- result.
-- See Note [tooldir: How GHC finds mingw on Windows]
@@ -251,11 +219,6 @@ getSetting = expr . setting
bashPath :: Action FilePath
bashPath = setting BourneShell
--- | An expression that looks up the value of a 'SettingList' in
--- @cfg/system.config@, tracking the result.
-getSettingList :: SettingList -> Args c b
-getSettingList = expr . settingList
-
-- | Check whether the value of a 'Setting' matches one of the given strings.
matchSetting :: Setting -> [String] -> Action Bool
matchSetting key values = (`elem` values) <$> setting key
@@ -370,3 +333,11 @@ libsuf st way
version <- ghcVersionStage st -- e.g. 8.4.4 or 8.9.xxxx
let suffix = waySuffix (removeWayUnit Dynamic way)
return (suffix ++ "-ghc" ++ version ++ extension)
+
+targetConfigStage :: Stage -> Action Target
+-- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET
+targetConfigStage (Stage0 {}) = getHostTargetConfig
+targetConfigStage (Stage1 {}) = getHostTargetConfig
+targetConfigStage (Stage2 {}) = getHostTargetConfig
+targetConfigStage (Stage3 {}) = getHostTargetConfig
+
=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -15,6 +15,8 @@ import Target
import Utilities
import qualified System.Directory.Extra as IO
import Data.Either
+import GHC.Toolchain (ccProgram, tgtCCompiler, ccLinkProgram, tgtCCompilerLink)
+import GHC.Toolchain.Program (prgFlags)
{-
Note [Binary distributions]
@@ -418,11 +420,11 @@ commonWrapper = pure $ "exec \"$executablename\" ${1+\"$@\"}\n"
-- echo 'HSC2HS_EXTRA="$(addprefix --cflag=,$(CONF_CC_OPTS_STAGE1)) $(addprefix --lflag=,$(CONF_GCC_LINKER_OPTS_STAGE1))"' >> "$(WRAPPER)"
hsc2hsWrapper :: Action String
hsc2hsWrapper = do
- ccArgs <- map ("--cflag=" <>) <$> settingList (ConfCcArgs Stage1)
- ldFlags <- map ("--lflag=" <>) <$> settingList (ConfGccLinkerArgs Stage1)
+ ccArgs <- map ("--cflag=" <>) . prgFlags . ccProgram . tgtCCompiler <$> targetConfigStage Stage1
+ linkFlags <- map ("--lflag=" <>) . prgFlags . ccLinkProgram . tgtCCompilerLink <$> targetConfigStage Stage1
wrapper <- drop 4 . lines <$> liftIO (readFile "utils/hsc2hs/hsc2hs.wrapper")
return $ unlines
- ( "HSC2HS_EXTRA=\"" <> unwords (ccArgs ++ ldFlags) <> "\""
+ ( "HSC2HS_EXTRA=\"" <> unwords (ccArgs ++ linkFlags) <> "\""
: "tflag=\"--template=$libdir/template-hsc.h\""
: "Iflag=\"-I$includedir/\""
: wrapper )
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -362,6 +362,9 @@ cppify :: String -> String
cppify = replaceEq '-' '_' . replaceEq '.' '_'
-- | Generate @ghcplatform.h@ header.
+-- ROMES:TODO: These will eventually have to be determined at runtime, and no
+-- longer hardcoded to a file (passed as -D flags to the preprocessor,
+-- probably)
generateGhcPlatformH :: Expr String
generateGhcPlatformH = do
trackGenerateHs
=====================================
hadrian/src/Rules/Gmp.hs
=====================================
@@ -12,6 +12,8 @@ import Utilities
import Hadrian.BuildPath
import Hadrian.Expression
import Settings.Builders.Common (cArgs)
+import GHC.Toolchain (ccProgram, tgtCCompiler)
+import GHC.Toolchain.Program
-- | Build in-tree GMP library objects (if GmpInTree flag is set) and return
-- their paths.
@@ -122,7 +124,7 @@ gmpRules = do
let gmpBuildP = takeDirectory mk
gmpP = takeDirectory gmpBuildP
ctx <- makeGmpPathContext gmpP
- cFlags <- interpretInContext ctx $ mconcat [ cArgs, getStagedSettingList ConfCcArgs ]
+ cFlags <- interpretInContext ctx $ mconcat [ cArgs, prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig ]
env <- sequence
[ builderEnvironment "CC" $ Cc CompileC (stage ctx)
, return . AddEnv "CFLAGS" $ unwords cFlags
=====================================
hadrian/src/Rules/Libffi.hs
=====================================
@@ -12,6 +12,8 @@ import Packages
import Settings.Builders.Common
import Target
import Utilities
+import GHC.Toolchain (ccProgram, tgtCCompiler)
+import GHC.Toolchain.Program
{- Note [Libffi indicating inputs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -131,7 +133,7 @@ configureEnvironment stage = do
context <- libffiContext stage
cFlags <- interpretInContext context $ mconcat
[ cArgs
- , getStagedSettingList ConfCcArgs ]
+ , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig ]
ldFlags <- interpretInContext context ldArgs
sequence [ builderEnvironment "CC" $ Cc CompileC stage
, builderEnvironment "CXX" $ Cc CompileC stage
=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -13,6 +13,8 @@ import Control.Exception (assert)
import qualified Data.Set as Set
import System.Directory
import Settings.Program (programContext)
+import GHC.Toolchain (ccProgram, tgtCCompiler, ccLinkProgram, tgtCCompilerLink)
+import GHC.Toolchain.Program (prgFlags)
cabalBuilderArgs :: Args
cabalBuilderArgs = cabalSetupArgs <> cabalInstallArgs
@@ -166,9 +168,9 @@ libraryArgs = do
-- | Configure args with stage/lib specific include directories and settings
configureStageArgs :: Args
configureStageArgs = do
- let cFlags = getStagedSettingList ConfCcArgs
- ldFlags = getStagedSettingList ConfGccLinkerArgs
- mconcat [ configureArgs cFlags ldFlags
+ let cFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig
+ linkFlags = prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig
+ mconcat [ configureArgs cFlags linkFlags
, notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h"
]
@@ -184,7 +186,7 @@ configureArgs cFlags' ldFlags' = do
not (null values) ?
arg ("--configure-option=" ++ key ++ "=" ++ values)
cFlags = mconcat [ remove ["-Werror"] cArgs
- , getStagedSettingList ConfCcArgs
+ , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig
-- See https://github.com/snowleopard/hadrian/issues/523
, arg $ "-iquote"
=====================================
hadrian/src/Settings/Builders/Cc.hs
=====================================
@@ -2,13 +2,15 @@ module Settings.Builders.Cc (ccBuilderArgs) where
import Hadrian.Haskell.Cabal.Type
import Settings.Builders.Common
+import GHC.Toolchain (tgtCCompiler, ccProgram)
+import GHC.Toolchain.Program
ccBuilderArgs :: Args
ccBuilderArgs = do
way <- getWay
builder Cc ? mconcat
[ getContextData ccOpts
- , getStagedSettingList ConfCcArgs
+ , prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig
, builder (Cc CompileC) ? mconcat
[ arg "-Wall"
=====================================
hadrian/src/Settings/Builders/DeriveConstants.hs
=====================================
@@ -5,6 +5,8 @@ module Settings.Builders.DeriveConstants (
import Builder
import Packages
import Settings.Builders.Common
+import GHC.Toolchain (tgtCCompiler, ccProgram)
+import GHC.Toolchain.Program
deriveConstantsPairs :: [(String, String)]
deriveConstantsPairs =
@@ -41,7 +43,7 @@ includeCcArgs = do
rtsPath <- expr $ rtsBuildPath stage
mconcat [ cArgs
, cWarnings
- , getSettingList $ ConfCcArgs Stage1
+ , prgFlags . ccProgram . tgtCCompiler <$> expr (targetConfigStage Stage1)
, flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
, arg "-Irts"
, arg "-Irts/include"
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -14,6 +14,8 @@ import Rules.Libffi (libffiName)
import qualified Data.Set as Set
import System.Directory
import Data.Version.Extra
+import GHC.Toolchain (ccProgram, tgtCCompiler, cppProgram, tgtCPreprocessor)
+import GHC.Toolchain.Program
ghcBuilderArgs :: Args
ghcBuilderArgs = mconcat
@@ -36,8 +38,8 @@ toolArgs = do
builder (Ghc ToolArgs) ? mconcat
[ packageGhcArgs
, includeGhcArgs
- , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
- , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
+ , map ("-optc" ++) <$> getStagedCCFlags
+ , map ("-optP" ++) <$> getStagedCPPFlags
, map ("-optP" ++) <$> getContextData cppOpts
, getContextData hcOpts
]
@@ -69,7 +71,7 @@ compileC :: Args
compileC = builder (Ghc CompileCWithGhc) ? do
way <- getWay
let ccArgs = [ getContextData ccOpts
- , getStagedSettingList ConfCcArgs
+ , getStagedCCFlags
, cIncludeArgs
, Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
mconcat [ arg "-Wall"
@@ -86,7 +88,7 @@ compileCxx :: Args
compileCxx = builder (Ghc CompileCppWithGhc) ? do
way <- getWay
let ccArgs = [ getContextData cxxOpts
- , getStagedSettingList ConfCcArgs
+ , getStagedCCFlags
, cIncludeArgs
, Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
mconcat [ arg "-Wall"
@@ -216,8 +218,8 @@ commonGhcArgs = do
-- to the @ghc-version@ file, to prevent GHC from trying to open the
-- RTS package in the package database and failing.
, package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h"
- , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
- , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
+ , map ("-optc" ++) <$> getStagedCCFlags
+ , map ("-optP" ++) <$> getStagedCPPFlags
, map ("-optP" ++) <$> getContextData cppOpts
, arg "-outputdir", arg path
-- we need to enable color explicitly because the output is
@@ -290,3 +292,10 @@ includeGhcArgs = do
, pure [ "-i" ++ d | d <- abSrcDirs ]
, cIncludeArgs
, pure ["-optP-include", "-optP" ++ cabalMacros] ]
+
+-- Utilities
+getStagedCCFlags :: Args
+getStagedCCFlags = prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig
+
+getStagedCPPFlags :: Args
+getStagedCPPFlags = prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig
=====================================
hadrian/src/Settings/Builders/HsCpp.hs
=====================================
@@ -2,12 +2,14 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where
import Packages
import Settings.Builders.Common
+import GHC.Toolchain
+import GHC.Toolchain.Program
hsCppBuilderArgs :: Args
hsCppBuilderArgs = builder HsCpp ? do
stage <- getStage
ghcPath <- expr $ buildPath (vanillaContext stage compiler)
- mconcat [ getSettingList HsCppArgs
+ mconcat [ prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: HsCppArgs, not CppArgs, make sure this is the case
, arg "-P"
, arg "-Irts/include"
, arg $ "-I" ++ ghcPath
=====================================
hadrian/src/Settings/Builders/Hsc2Hs.hs
=====================================
@@ -5,6 +5,8 @@ import Hadrian.Haskell.Cabal.Type
import Builder
import Packages
import Settings.Builders.Common
+import GHC.Toolchain (tgtCCompiler, ccProgram, tgtCPreprocessor, cppProgram, tgtCCompilerLink, ccLinkProgram)
+import GHC.Toolchain.Program
hsc2hsBuilderArgs :: Args
hsc2hsBuilderArgs = builder Hsc2Hs ? do
@@ -49,8 +51,8 @@ getCFlags = do
autogen <- expr $ autogenPath context
let cabalMacros = autogen -/- "cabal_macros.h"
expr $ need [cabalMacros]
- mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
- , getStagedSettingList ConfCppArgs
+ mconcat [ remove ["-O"] (cArgs <> (prgFlags . ccProgram . tgtCCompiler <$> getStagedTargetConfig))
+ , prgFlags . cppProgram . tgtCPreprocessor <$> getStagedTargetConfig -- ROMES:TODO: CppArgs, not HsCppArgs, make sure this is the case
, cIncludeArgs
, getContextData ccOpts
-- we might be able to leave out cppOpts, to be investigated.
@@ -61,7 +63,7 @@ getCFlags = do
getLFlags :: Expr [String]
getLFlags =
- mconcat [ getStagedSettingList ConfGccLinkerArgs
+ mconcat [ prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig
, ldArgs
, getContextData ldOpts
, getContextData depLdOpts ]
=====================================
hadrian/src/Settings/Builders/Ld.hs
=====================================
@@ -1,8 +1,10 @@
module Settings.Builders.Ld (ldBuilderArgs) where
import Settings.Builders.Common
+import GHC.Toolchain
+import GHC.Toolchain.Program
ldBuilderArgs :: Args
-ldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs
+ldBuilderArgs = builder Ld ? mconcat [ prgFlags . ccLinkProgram . tgtCCompilerLink <$> getStagedTargetConfig
, arg "-o", arg =<< getOutput
, getInputs ]
=====================================
hadrian/src/Settings/Builders/MergeObjects.hs
=====================================
@@ -1,9 +1,11 @@
module Settings.Builders.MergeObjects (mergeObjectsBuilderArgs) where
import Settings.Builders.Common
+import GHC.Toolchain
+import GHC.Toolchain.Program
mergeObjectsBuilderArgs :: Args
mergeObjectsBuilderArgs = builder MergeObjects ? mconcat
- [ getStagedSettingList ConfMergeObjectsArgs
+ [ (maybe [] (prgFlags . mergeObjsProgram) . tgtMergeObjs) <$> getStagedTargetConfig
, arg "-o", arg =<< getOutput
, getInputs ]
=====================================
m4/fptools_set_haskell_platform_vars.m4
=====================================
@@ -40,4 +40,7 @@ AC_DEFUN([GHC_SUBSECTIONS_VIA_SYMBOLS],
AC_MSG_RESULT(no)])
])
-# ROMES:TODO: We can't still remove this because of the DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts
+# ROMES:TODO: We can't still remove this because of the #DEFINE HAVE_SUBSECTIONS_VIA_SYMBOLS 1, which is used in the rts
+# We might have to generate a bunch of -D CPP flags to satisfy these dependencies (future work).
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc...f83f08a950d6f3a8bcf04289402e51d89c04bc4f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc52a47ffb63f6e3dfd79d48cf1100e383e32cc...f83f08a950d6f3a8bcf04289402e51d89c04bc4f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230515/f235984a/attachment-0001.html>
More information about the ghc-commits
mailing list