Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: 5e74adc1 by Rodrigo Mesquita at 2025-07-16T19:11:39+01:00 Read Toolchain.Target files rather than 'settings' This commit makes GHC read `lib/targets/default.target`, a file with a serialized value of `ghc-toolchain`'s `GHC.Toolchain.Target`. Moreover, it removes all the now-redundant entries from `lib/settings` that are configured as part of a `Target` but were being written into `settings`. This makes it easier to support multiple targets from the same compiler (aka runtime retargetability). `ghc-toolchain` can be re-run many times standalone to produce a `Target` description for different targets, and, in the future, GHC will be able to pick at runtime amongst different `Target` files. This commit only makes it read the default `Target` configured in-tree or configured when installing the bindist. The remaining bits of `settings` need to be moved to `Target` in follow up commits, but ultimately they all should be moved since they are per-target relevant. Fixes #24212 On Windows, the constant overhead of parsing a slightly more complex data structure causes some small-allocation tests to wiggle around 1 to 2 extra MB (1-2% in these cases). ------------------------- Metric Increase: MultiLayerModulesTH_OneShot T10421 T10547 T12234 T12425 T13035 T18140 T18923 T9198 TcPlugin_RewritePerf ------------------------- - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs - − m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - + m4/subst_tooldir.m4 - mk/hsc2hs.in - testsuite/tests/ghc-api/T20757.hs - testsuite/tests/ghc-api/settings-escape/T24265.hs - testsuite/tests/ghc-api/settings-escape/T24265.stderr - + testsuite/tests/ghc-api/settings-escape/ghc-install-folder/lib with spaces/targets/.gitkeep - utils/ghc-pkg/Main.hs - utils/ghc-pkg/ghc-pkg.cabal.in - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -145,6 +145,7 @@ import GHC.Foreign (withCString, peekCString) import qualified Data.Set as Set import qualified GHC.LanguageExtensions as LangExt +import GHC.Toolchain.Target (Target) -- ----------------------------------------------------------------------------- -- DynFlags @@ -178,6 +179,7 @@ data DynFlags = DynFlags { toolSettings :: {-# UNPACK #-} !ToolSettings, platformMisc :: {-# UNPACK #-} !PlatformMisc, rawSettings :: [(String, String)], + rawTarget :: Target, tmpDir :: TempDir, llvmOptLevel :: Int, -- ^ LLVM optimisation level @@ -656,6 +658,7 @@ defaultDynFlags mySettings = targetPlatform = sTargetPlatform mySettings, platformMisc = sPlatformMisc mySettings, rawSettings = sRawSettings mySettings, + rawTarget = sRawTarget mySettings, tmpDir = panic "defaultDynFlags: uninitialized tmpDir", ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -280,6 +280,9 @@ import GHC.Parser.Lexer (mkParserOpts, initParserState, P(..), ParseResult(..)) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) +import GHC.Toolchain +import GHC.Toolchain.Program + import Data.IORef import Control.Arrow ((&&&)) import Control.Monad @@ -403,6 +406,7 @@ settings dflags = Settings , sToolSettings = toolSettings dflags , sPlatformMisc = platformMisc dflags , sRawSettings = rawSettings dflags + , sRawTarget = rawTarget dflags } pgm_L :: DynFlags -> String @@ -3454,9 +3458,58 @@ compilerInfo dflags -- Next come the settings, so anything else can be overridden -- in the settings file (as "lookup" uses the first match for the -- key) - : map (fmap $ expandDirectories (topDir dflags) (toolDir dflags)) - (rawSettings dflags) - ++ [("Project version", projectVersion dflags), + : map (fmap expandDirectories) + (rawSettings dflags) + ++ + [("C compiler command", queryCmd $ ccProgram . tgtCCompiler), + ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler), + ("C++ compiler command", queryCmd $ cxxProgram . tgtCxxCompiler), + ("C++ compiler flags", queryFlags $ cxxProgram . tgtCxxCompiler), + ("C compiler link flags", queryFlags $ ccLinkProgram . tgtCCompilerLink), + ("C compiler supports -no-pie", queryBool $ ccLinkSupportsNoPie . tgtCCompilerLink), + ("CPP command", queryCmd $ cppProgram . tgtCPreprocessor), + ("CPP flags", queryFlags $ cppProgram . tgtCPreprocessor), + ("Haskell CPP command", queryCmd $ hsCppProgram . tgtHsCPreprocessor), + ("Haskell CPP flags", queryFlags $ hsCppProgram . tgtHsCPreprocessor), + ("JavaScript CPP command", queryCmdMaybe jsCppProgram tgtJsCPreprocessor), + ("JavaScript CPP flags", queryFlagsMaybe jsCppProgram tgtJsCPreprocessor), + ("C-- CPP command", queryCmd $ cmmCppProgram . tgtCmmCPreprocessor), + ("C-- CPP flags", queryFlags $ cmmCppProgram . tgtCmmCPreprocessor), + ("C-- CPP supports -g0", queryBool $ cmmCppSupportsG0 . tgtCmmCPreprocessor), + ("ld supports compact unwind", queryBool $ ccLinkSupportsCompactUnwind . tgtCCompilerLink), + ("ld supports filelist", queryBool $ ccLinkSupportsFilelist . tgtCCompilerLink), + ("ld supports single module", queryBool $ ccLinkSupportsSingleModule . tgtCCompilerLink), + ("ld is GNU ld", queryBool $ ccLinkIsGnu . tgtCCompilerLink), + ("Merge objects command", queryCmdMaybe mergeObjsProgram tgtMergeObjs), + ("Merge objects flags", queryFlagsMaybe mergeObjsProgram tgtMergeObjs), + ("Merge objects supports response files", queryBool $ maybe False mergeObjsSupportsResponseFiles . tgtMergeObjs), + ("ar command", queryCmd $ arMkArchive . tgtAr), + ("ar flags", queryFlags $ arMkArchive . tgtAr), + ("ar supports at file", queryBool $ arSupportsAtFile . tgtAr), + ("ar supports -L", queryBool $ arSupportsDashL . tgtAr), + ("ranlib command", queryCmdMaybe ranlibProgram tgtRanlib), + ("otool command", queryCmdMaybe id tgtOtool), + ("install_name_tool command", queryCmdMaybe id tgtInstallNameTool), + ("windres command", queryCmd $ fromMaybe (Program "/bin/false" []) . tgtWindres), + ("cross compiling", queryBool (not . tgtLocallyExecutable)), + ("target platform string", query targetPlatformTriple), + ("target os", query (show . archOS_OS . tgtArchOs)), + ("target arch", query (show . archOS_arch . tgtArchOs)), + ("target word size", query $ show . wordSize2Bytes . tgtWordSize), + ("target word big endian", queryBool $ (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness), + ("target has GNU nonexec stack", queryBool tgtSupportsGnuNonexecStack), + ("target has .ident directive", queryBool tgtSupportsIdentDirective), + ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("Unregisterised", queryBool tgtUnregisterised), + ("LLVM target", query tgtLlvmTarget), + ("LLVM llc command", queryCmdMaybe id tgtLlc), + ("LLVM opt command", queryCmdMaybe id tgtOpt), + ("LLVM llvm-as command", queryCmdMaybe id tgtLlvmAs), + ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), + ("Tables next to code", queryBool tgtTablesNextToCode), + ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ] ++ + [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), ("Project Version Int", cProjectVersionInt), ("Project Patch Level", cProjectPatchLevel), @@ -3513,9 +3566,16 @@ compilerInfo dflags showBool False = "NO" platform = targetPlatform dflags isWindows = platformOS platform == OSMinGW32 - useInplaceMinGW = toolSettings_useInplaceMinGW $ toolSettings dflags - expandDirectories :: FilePath -> Maybe FilePath -> String -> String - expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd + expandDirectories = expandToolDir (toolDir dflags) . expandTopDir (topDir dflags) + query :: (Target -> a) -> a + query f = f (rawTarget dflags) + queryFlags f = query (unwords . map escapeArg . prgFlags . f) + queryCmd f = expandDirectories (query (prgPath . f)) + queryBool = showBool . query + + queryCmdMaybe, queryFlagsMaybe :: (a -> Program) -> (Target -> Maybe a) -> String + queryCmdMaybe p f = expandDirectories (query (maybe "" (prgPath . p) . f)) + queryFlagsMaybe p f = query (maybe "" (unwords . map escapeArg . prgFlags . p) . f) -- Note [Special unit-ids] -- ~~~~~~~~~~~~~~~~~~~~~~~ @@ -3843,3 +3903,19 @@ updatePlatformConstants dflags mconstants = do let platform1 = (targetPlatform dflags) { platform_constants = mconstants } let dflags1 = dflags { targetPlatform = platform1 } return dflags1 + +-- ---------------------------------------------------------------------------- +-- Escape Args helpers +-- ---------------------------------------------------------------------------- + +-- | Just like 'GHC.ResponseFile.escapeArg', but it is not exposed from base. +escapeArg :: String -> String +escapeArg = reverse . foldl' escape [] + +escape :: String -> Char -> String +escape cs c + | isSpace c + || '\\' == c + || '\'' == c + || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result + | otherwise = c:cs ===================================== compiler/GHC/Settings.hs ===================================== @@ -23,7 +23,6 @@ module GHC.Settings , sMergeObjsSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie - , sUseInplaceMinGW , sArSupportsDashL , sPgm_L , sPgm_P @@ -75,6 +74,7 @@ import GHC.Utils.CliOption import GHC.Utils.Fingerprint import GHC.Platform import GHC.Unit.Types +import GHC.Toolchain.Target data Settings = Settings { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion @@ -87,6 +87,10 @@ data Settings = Settings -- You shouldn't need to look things up in rawSettings directly. -- They should have their own fields instead. , sRawSettings :: [(String, String)] + + -- Store the target to print out information about the raw target description + -- (e.g. in --info) + , sRawTarget :: Target } data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId } @@ -102,7 +106,6 @@ data ToolSettings = ToolSettings , toolSettings_mergeObjsSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool - , toolSettings_useInplaceMinGW :: Bool , toolSettings_arSupportsDashL :: Bool , toolSettings_cmmCppSupportsG0 :: Bool @@ -221,8 +224,6 @@ sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings -sUseInplaceMinGW :: Settings -> Bool -sUseInplaceMinGW = toolSettings_useInplaceMinGW . sToolSettings sArSupportsDashL :: Settings -> Bool sArSupportsDashL = toolSettings_arSupportsDashL . sToolSettings ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -1,4 +1,4 @@ - +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -16,18 +16,20 @@ import GHC.Utils.CliOption import GHC.Utils.Fingerprint import GHC.Platform import GHC.Utils.Panic -import GHC.ResponseFile import GHC.Settings import GHC.SysTools.BaseDir import GHC.Unit.Types import Control.Monad.Trans.Except import Control.Monad.IO.Class -import Data.Char import qualified Data.Map as Map import System.FilePath import System.Directory +import GHC.Toolchain.Program +import GHC.Toolchain +import GHC.Data.Maybe +import Data.Bifunctor (Bifunctor(second)) data SettingsError = SettingsError_MissingData String @@ -44,6 +46,7 @@ initSettings top_dir = do libexec :: FilePath -> FilePath libexec file = top_dir ".." "bin" file settingsFile = installed "settings" + targetFile = installed $ "targets" "default.target" readFileSafe :: FilePath -> ExceptT SettingsError m String readFileSafe path = liftIO (doesFileExist path) >>= \case @@ -55,85 +58,72 @@ initSettings top_dir = do Just s -> pure s Nothing -> throwE $ SettingsError_BadData $ "Can't parse " ++ show settingsFile + targetStr <- readFileSafe targetFile + target <- case maybeReadFuzzy @Target targetStr of + Just s -> pure s + Nothing -> throwE $ SettingsError_BadData $ + "Can't parse as Target " ++ show targetFile let mySettings = Map.fromList settingsList getBooleanSetting :: String -> ExceptT SettingsError m Bool getBooleanSetting key = either pgmError pure $ getRawBooleanSetting settingsFile mySettings key - -- On Windows, by mingw is often distributed with GHC, - -- so we look in TopDir/../mingw/bin, - -- as well as TopDir/../../mingw/bin for hadrian. - -- But we might be disabled, in which we we don't do that. - useInplaceMinGW <- getBooleanSetting "Use inplace MinGW toolchain" - -- see Note [topdir: How GHC finds its files] -- NB: top_dir is assumed to be in standard Unix -- format, '/' separated - mtool_dir <- liftIO $ findToolDir useInplaceMinGW top_dir + mtool_dir <- liftIO $ findToolDir top_dir -- see Note [tooldir: How GHC finds mingw on Windows] - -- Escape 'top_dir' and 'mtool_dir', to make sure we don't accidentally - -- introduce unescaped spaces. See #24265 and #25204. - let escaped_top_dir = escapeArg top_dir - escaped_mtool_dir = fmap escapeArg mtool_dir - - getSetting_raw key = either pgmError pure $ + let getSetting_raw key = either pgmError pure $ getRawSetting settingsFile mySettings key getSetting_topDir top key = either pgmError pure $ getRawFilePathSetting top settingsFile mySettings key getSetting_toolDir top tool key = - expandToolDir useInplaceMinGW tool <$> getSetting_topDir top key - - getSetting :: String -> ExceptT SettingsError m String + expandToolDir tool <$> getSetting_topDir top key getSetting key = getSetting_topDir top_dir key - getToolSetting :: String -> ExceptT SettingsError m String getToolSetting key = getSetting_toolDir top_dir mtool_dir key - getFlagsSetting :: String -> ExceptT SettingsError m [String] - getFlagsSetting key = unescapeArgs <$> getSetting_toolDir escaped_top_dir escaped_mtool_dir key - -- Make sure to unescape, as we have escaped top_dir and tool_dir. + + expandDirVars top tool = expandToolDir tool . expandTopDir top + + getToolPath :: (Target -> Program) -> String + getToolPath key = expandDirVars top_dir mtool_dir (prgPath . key $ target) + + getMaybeToolPath :: (Target -> Maybe Program) -> String + getMaybeToolPath key = getToolPath (fromMaybe (Program "" []) . key) + + getToolFlags :: (Target -> Program) -> [String] + getToolFlags key = expandDirVars top_dir mtool_dir <$> (prgFlags . key $ target) + + getTool :: (Target -> Program) -> (String, [String]) + getTool key = (getToolPath key, getToolFlags key) -- See Note [Settings file] for a little more about this file. We're -- just partially applying those functions and throwing 'Left's; they're -- written in a very portable style to keep ghc-boot light. - targetPlatformString <- getSetting_raw "target platform string" - cc_prog <- getToolSetting "C compiler command" - cxx_prog <- getToolSetting "C++ compiler command" - cc_args0 <- getFlagsSetting "C compiler flags" - cxx_args <- getFlagsSetting "C++ compiler flags" - gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cmmCppSupportsG0 <- getBooleanSetting "C-- CPP supports -g0" - cpp_prog <- getToolSetting "CPP command" - cpp_args <- map Option <$> getFlagsSetting "CPP flags" - hs_cpp_prog <- getToolSetting "Haskell CPP command" - hs_cpp_args <- map Option <$> getFlagsSetting "Haskell CPP flags" - js_cpp_prog <- getToolSetting "JavaScript CPP command" - js_cpp_args <- map Option <$> getFlagsSetting "JavaScript CPP flags" - cmmCpp_prog <- getToolSetting "C-- CPP command" - cmmCpp_args <- map Option <$> getFlagsSetting "C-- CPP flags" - - platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings - - let unreg_cc_args = if platformUnregisterised platform - then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] - else [] - cc_args = cc_args0 ++ unreg_cc_args - - -- The extra flags we need to pass gcc when we invoke it to compile .hc code. - -- - -- -fwrapv is needed for gcc to emit well-behaved code in the presence of - -- integer wrap around (#952). - extraGccViaCFlags = if platformUnregisterised platform - -- configure guarantees cc support these flags - then ["-fwrapv", "-fno-builtin"] - else [] - - ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" - ldSupportsFilelist <- getBooleanSetting "ld supports filelist" - ldSupportsSingleModule <- getBooleanSetting "ld supports single module" - mergeObjsSupportsResponseFiles <- getBooleanSetting "Merge objects supports response files" - ldIsGnuLd <- getBooleanSetting "ld is GNU ld" - arSupportsDashL <- getBooleanSetting "ar supports -L" - + targetHasLibm <- getBooleanSetting "target has libm" + let + (cc_prog, cc_args0) = getTool (ccProgram . tgtCCompiler) + (cxx_prog, cxx_args) = getTool (cxxProgram . tgtCxxCompiler) + (cpp_prog, cpp_args) = getTool (cppProgram . tgtCPreprocessor) + (hs_cpp_prog, hs_cpp_args) = getTool (hsCppProgram . tgtHsCPreprocessor) + (js_cpp_prog, js_cpp_args) = getTool (maybe (Program "" []) jsCppProgram . tgtJsCPreprocessor) + (cmmCpp_prog, cmmCpp_args) = getTool (cmmCppProgram . tgtCmmCPreprocessor) + + platform = getTargetPlatform targetHasLibm target + + unreg_cc_args = if platformUnregisterised platform + then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] + else [] + cc_args = cc_args0 ++ unreg_cc_args + + -- The extra flags we need to pass gcc when we invoke it to compile .hc code. + -- + -- -fwrapv is needed for gcc to emit well-behaved code in the presence of + -- integer wrap around (#952). + extraGccViaCFlags = if platformUnregisterised platform + -- configure guarantees cc support these flags + then ["-fwrapv", "-fno-builtin"] + else [] -- The package database is either a relative path to the location of the settings file -- OR an absolute path. @@ -148,41 +138,20 @@ initSettings top_dir = do -- architecture-specific stuff is done when building Config.hs unlit_path <- getToolSetting "unlit command" - windres_path <- getToolSetting "windres command" - ar_path <- getToolSetting "ar command" - otool_path <- getToolSetting "otool command" - install_name_tool_path <- getToolSetting "install_name_tool command" - ranlib_path <- getToolSetting "ranlib command" - - -- HACK, see setPgmP below. We keep 'words' here to remember to fix - -- Config.hs one day. - - - -- Other things being equal, 'as' and 'ld' are simply 'gcc' - cc_link_args <- getFlagsSetting "C compiler link flags" - let as_prog = cc_prog - as_args = map Option cc_args - ld_prog = cc_prog - ld_args = map Option (cc_args ++ cc_link_args) - ld_r_prog <- getToolSetting "Merge objects command" - ld_r_args <- getFlagsSetting "Merge objects flags" - let ld_r - | null ld_r_prog = Nothing - | otherwise = Just (ld_r_prog, map Option ld_r_args) - - llvmTarget <- getSetting_raw "LLVM target" - - -- We just assume on command line - lc_prog <- getToolSetting "LLVM llc command" - lo_prog <- getToolSetting "LLVM opt command" - las_prog <- getToolSetting "LLVM llvm-as command" - las_args <- map Option <$> getFlagsSetting "LLVM llvm-as flags" - - let iserv_prog = libexec "ghc-iserv" + -- Other things being equal, 'as' is simply 'gcc' + let (cc_link, cc_link_args) = getTool (ccLinkProgram . tgtCCompilerLink) + as_prog = cc_prog + as_args = map Option cc_args + ld_prog = cc_link + ld_args = map Option (cc_args ++ cc_link_args) + ld_r = do + ld_r_prog <- tgtMergeObjs target + let (ld_r_path, ld_r_args) = getTool (mergeObjsProgram . const ld_r_prog) + pure (ld_r_path, map Option ld_r_args) + iserv_prog = libexec "ghc-iserv" targetRTSLinkerOnlySupportsSharedLibs <- getBooleanSetting "target RTS linker only supports shared libraries" ghcWithInterpreter <- getBooleanSetting "Use interpreter" - useLibFFI <- getBooleanSetting "Use LibFFI" baseUnitId <- getSetting_raw "base unit-id" @@ -206,36 +175,38 @@ initSettings top_dir = do } , sToolSettings = ToolSettings - { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind - , toolSettings_ldSupportsFilelist = ldSupportsFilelist - , toolSettings_ldSupportsSingleModule = ldSupportsSingleModule - , toolSettings_mergeObjsSupportsResponseFiles = mergeObjsSupportsResponseFiles - , toolSettings_ldIsGnuLd = ldIsGnuLd - , toolSettings_ccSupportsNoPie = gccSupportsNoPie - , toolSettings_useInplaceMinGW = useInplaceMinGW - , toolSettings_arSupportsDashL = arSupportsDashL - , toolSettings_cmmCppSupportsG0 = cmmCppSupportsG0 - - , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) - , toolSettings_pgm_JSP = (js_cpp_prog, js_cpp_args) - , toolSettings_pgm_CmmP = (cmmCpp_prog, cmmCpp_args) - , toolSettings_pgm_F = "" - , toolSettings_pgm_c = cc_prog - , toolSettings_pgm_cxx = cxx_prog - , toolSettings_pgm_cpp = (cpp_prog, cpp_args) - , toolSettings_pgm_a = (as_prog, as_args) - , toolSettings_pgm_l = (ld_prog, ld_args) - , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_windres = windres_path - , toolSettings_pgm_ar = ar_path - , toolSettings_pgm_otool = otool_path - , toolSettings_pgm_install_name_tool = install_name_tool_path - , toolSettings_pgm_ranlib = ranlib_path - , toolSettings_pgm_lo = (lo_prog,[]) - , toolSettings_pgm_lc = (lc_prog,[]) - , toolSettings_pgm_las = (las_prog, las_args) - , toolSettings_pgm_i = iserv_prog + { toolSettings_ldSupportsCompactUnwind = ccLinkSupportsCompactUnwind $ tgtCCompilerLink target + , toolSettings_ldSupportsFilelist = ccLinkSupportsFilelist $ tgtCCompilerLink target + , toolSettings_ldSupportsSingleModule = ccLinkSupportsSingleModule $ tgtCCompilerLink target + , toolSettings_ldIsGnuLd = ccLinkIsGnu $ tgtCCompilerLink target + , toolSettings_ccSupportsNoPie = ccLinkSupportsNoPie $ tgtCCompilerLink target + , toolSettings_mergeObjsSupportsResponseFiles + = maybe False mergeObjsSupportsResponseFiles + $ tgtMergeObjs target + , toolSettings_arSupportsDashL = arSupportsDashL $ tgtAr target + , toolSettings_cmmCppSupportsG0 = cmmCppSupportsG0 $ tgtCmmCPreprocessor target + + , toolSettings_pgm_L = unlit_path + , toolSettings_pgm_P = (hs_cpp_prog, map Option hs_cpp_args) + , toolSettings_pgm_JSP = (js_cpp_prog, map Option js_cpp_args) + , toolSettings_pgm_CmmP = (cmmCpp_prog, map Option cmmCpp_args) + , toolSettings_pgm_F = "" + , toolSettings_pgm_c = cc_prog + , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, map Option cpp_args) + , toolSettings_pgm_a = (as_prog, as_args) + , toolSettings_pgm_l = (ld_prog, ld_args) + , toolSettings_pgm_lm = ld_r + , toolSettings_pgm_windres = getMaybeToolPath tgtWindres + , toolSettings_pgm_ar = getToolPath (arMkArchive . tgtAr) + , toolSettings_pgm_otool = getMaybeToolPath tgtOtool + , toolSettings_pgm_install_name_tool = getMaybeToolPath tgtInstallNameTool + , toolSettings_pgm_ranlib = getMaybeToolPath (fmap ranlibProgram . tgtRanlib) + , toolSettings_pgm_lo = (getMaybeToolPath tgtOpt,[]) + , toolSettings_pgm_lc = (getMaybeToolPath tgtLlc,[]) + , toolSettings_pgm_las = second (map Option) $ + getTool (fromMaybe (Program "" []) . tgtLlvmAs) + , toolSettings_pgm_i = iserv_prog , toolSettings_opt_L = [] , toolSettings_opt_P = [] , toolSettings_opt_JSP = [] @@ -260,65 +231,30 @@ initSettings top_dir = do , sTargetPlatform = platform , sPlatformMisc = PlatformMisc - { platformMisc_targetPlatformString = targetPlatformString + { platformMisc_targetPlatformString = targetPlatformTriple target , platformMisc_ghcWithInterpreter = ghcWithInterpreter - , platformMisc_libFFI = useLibFFI - , platformMisc_llvmTarget = llvmTarget + , platformMisc_libFFI = tgtUseLibffiForAdjustors target + , platformMisc_llvmTarget = tgtLlvmTarget target , platformMisc_targetRTSLinkerOnlySupportsSharedLibs = targetRTSLinkerOnlySupportsSharedLibs } , sRawSettings = settingsList + , sRawTarget = target } -getTargetPlatform - :: FilePath -- ^ Settings filepath (for error messages) - -> RawSettings -- ^ Raw settings file contents - -> Either String Platform -getTargetPlatform settingsFile settings = do - let - getBooleanSetting = getRawBooleanSetting settingsFile settings - readSetting :: (Show a, Read a) => String -> Either String a - readSetting = readRawSetting settingsFile settings - - targetArchOS <- getTargetArchOS settingsFile settings - targetWordSize <- readSetting "target word size" - targetWordBigEndian <- getBooleanSetting "target word big endian" - targetLeadingUnderscore <- getBooleanSetting "Leading underscore" - targetUnregisterised <- getBooleanSetting "Unregisterised" - targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack" - targetHasIdentDirective <- getBooleanSetting "target has .ident directive" - targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols" - targetHasLibm <- getBooleanSetting "target has libm" - crossCompiling <- getBooleanSetting "cross compiling" - tablesNextToCode <- getBooleanSetting "Tables next to code" - - pure $ Platform - { platformArchOS = targetArchOS - , platformWordSize = targetWordSize - , platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian - , platformUnregisterised = targetUnregisterised - , platformHasGnuNonexecStack = targetHasGnuNonexecStack - , platformHasIdentDirective = targetHasIdentDirective - , platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols - , platformIsCrossCompiling = crossCompiling - , platformLeadingUnderscore = targetLeadingUnderscore - , platformTablesNextToCode = tablesNextToCode +getTargetPlatform :: Bool {-^ Does target have libm -} -> Target -> Platform +getTargetPlatform targetHasLibm Target{..} = Platform + { platformArchOS = tgtArchOs + , platformWordSize = case tgtWordSize of WS4 -> PW4 + WS8 -> PW8 + , platformByteOrder = tgtEndianness + , platformUnregisterised = tgtUnregisterised + , platformHasGnuNonexecStack = tgtSupportsGnuNonexecStack + , platformHasIdentDirective = tgtSupportsIdentDirective + , platformHasSubsectionsViaSymbols = tgtSupportsSubsectionsViaSymbols + , platformIsCrossCompiling = not tgtLocallyExecutable + , platformLeadingUnderscore = tgtSymbolsHaveLeadingUnderscore + , platformTablesNextToCode = tgtTablesNextToCode , platformHasLibm = targetHasLibm , platform_constants = Nothing -- will be filled later when loading (or building) the RTS unit } - --- ---------------------------------------------------------------------------- --- Escape Args helpers --- ---------------------------------------------------------------------------- - --- | Just like 'GHC.ResponseFile.escapeArg', but it is not exposed from base. -escapeArg :: String -> String -escapeArg = reverse . foldl' escape [] - -escape :: String -> Char -> String -escape cs c - | isSpace c - || '\\' == c - || '\'' == c - || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result - | otherwise = c:cs ===================================== compiler/GHC/SysTools/BaseDir.hs ===================================== @@ -90,13 +90,10 @@ the build system finds and wires through the toolchain information. 3) The next step is to generate the settings file: The file `cfg/system.config.in` is preprocessed by configure and the output written to `system.config`. This serves the same purpose as `config.mk` but it rewrites - the values that were exported. As an example `SettingsCCompilerCommand` is - rewritten to `settings-c-compiler-command`. + the values that were exported. Next up is `src/Oracles/Settings.hs` which makes from some Haskell ADT to - the settings `keys` in the `system.config`. As an example, - `settings-c-compiler-command` is mapped to - `SettingsFileSetting_CCompilerCommand`. + the settings `keys` in the `system.config`. The last part of this is the `generateSettings` in `src/Rules/Generate.hs` which produces the desired settings file out of Hadrian. This is the @@ -122,15 +119,13 @@ play nice with the system compiler instead. -- | Expand occurrences of the @$tooldir@ interpolation in a string -- on Windows, leave the string untouched otherwise. expandToolDir - :: Bool -- ^ whether we use the ambient mingw toolchain - -> Maybe FilePath -- ^ tooldir + :: Maybe FilePath -- ^ tooldir -> String -> String #if defined(mingw32_HOST_OS) -expandToolDir False (Just tool_dir) s = expandPathVar "tooldir" tool_dir s -expandToolDir False Nothing _ = panic "Could not determine $tooldir" -expandToolDir True _ s = s +expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s +expandToolDir Nothing _ = panic "Could not determine $tooldir" #else -expandToolDir _ _ s = s +expandToolDir _ s = s #endif -- | Returns a Unix-format path pointing to TopDir. @@ -164,13 +159,13 @@ tryFindTopDir Nothing -- Returns @Nothing@ when not on Windows. -- When called on Windows, it either throws an error when the -- tooldir can't be located, or returns @Just tooldirpath@. --- If the distro toolchain is being used we treat Windows the same as Linux +-- If the distro toolchain is being used, there will be no variables to +-- substitute for anyway, so this is a no-op. findToolDir - :: Bool -- ^ whether we use the ambient mingw toolchain - -> FilePath -- ^ topdir + :: FilePath -- ^ topdir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) -findToolDir False top_dir = go 0 (top_dir "..") [] +findToolDir top_dir = go 0 (top_dir "..") [] where maxDepth = 3 go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath) go k path tried @@ -183,7 +178,6 @@ findToolDir False top_dir = go 0 (top_dir "..") [] if oneLevel then return (Just path) else go (k+1) (path "..") tried' -findToolDir True _ = return Nothing #else -findToolDir _ _ = return Nothing +findToolDir _ = return Nothing #endif ===================================== compiler/ghc.cabal.in ===================================== @@ -131,6 +131,7 @@ Library semaphore-compat, stm, rts, + ghc-toolchain, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ ===================================== configure.ac ===================================== @@ -132,6 +132,7 @@ AC_ARG_ENABLE(distro-toolchain, [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])], [EnableDistroToolchain=NO] ) +AC_SUBST([EnableDistroToolchain]) if test "$EnableDistroToolchain" = "YES"; then TarballsAutodownload=NO @@ -752,8 +753,6 @@ FP_PROG_AR_NEEDS_RANLIB dnl ** Check to see whether ln -s works AC_PROG_LN_S -FP_SETTINGS - dnl ** Find the path to sed AC_PATH_PROGS(SedCmd,gsed sed,sed) ===================================== distrib/configure.ac.in ===================================== @@ -89,8 +89,9 @@ AC_ARG_ENABLE(distro-toolchain, [AS_HELP_STRING([--enable-distro-toolchain], [Do not use bundled Windows toolchain binaries.])], [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])], - [EnableDistroToolchain=@SettingsUseDistroMINGW@] + [EnableDistroToolchain=@EnableDistroToolchain@] ) +AC_SUBST([EnableDistroToolchain]) if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../mingw/]) @@ -384,8 +385,6 @@ fi AC_SUBST(BaseUnitId) -FP_SETTINGS - # We get caught by # http://savannah.gnu.org/bugs/index.php?1516 # $(eval ...) inside conditionals causes errors @@ -418,6 +417,34 @@ AC_OUTPUT VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) +if test "$EnableDistroToolchain" = "YES"; then + # If the user specified --enable-distro-toolchain then we just use the + # executable names, not paths. We do this by finding strings of paths to + # programs and keeping the basename only: + cp default.target default.target.bak + + while IFS= read -r line; do + if echo "$line" | grep -q 'prgPath = "'; then + path=$(echo "$line" | sed -E 's/.*prgPath = "([[^"]]+)".*/\1/') + base=$(basename "$path") + echo "$line" | sed "s|$path|$base|" + else + echo "$line" + fi + done < default.target.bak > default.target + echo "Applied --enable-distro-toolchain basename substitution to default.target:" + cat default.target +fi + +if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then + # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. + # We need to issue a substitution to use $tooldir, + # See Note [tooldir: How GHC finds mingw on Windows] + SUBST_TOOLDIR([default.target]) + echo "Applied tooldir substitution to default.target:" + cat default.target +fi + rm -Rf acargs acghc-toolchain actmp-ghc-toolchain echo "****************************************************" ===================================== hadrian/bindist/Makefile ===================================== @@ -85,67 +85,22 @@ WrapperBinsDir=${bindir} # N.B. this is duplicated from includes/ghc.mk. lib/settings : config.mk @rm -f $@ - @echo '[("C compiler command", "$(SettingsCCompilerCommand)")' >> $@ - @echo ',("C compiler flags", "$(SettingsCCompilerFlags)")' >> $@ - @echo ',("C++ compiler command", "$(SettingsCxxCompilerCommand)")' >> $@ - @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ - @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ - @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ - @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ - @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ - @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ - @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("JavaScript CPP command", "$(SettingsJavaScriptCPPCommand)")' >> $@ - @echo ',("JavaScript CPP flags", "$(SettingsJavaScriptCPPFlags)")' >> $@ - @echo ',("C-- CPP command", "$(SettingsCmmCPPCommand)")' >> $@ - @echo ',("C-- CPP flags", "$(SettingsCmmCPPFlags)")' >> $@ - @echo ',("C-- CPP supports -g0", "$(SettingsCmmCPPSupportsG0)")' >> $@ - @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ - @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ - @echo ',("ld supports single module", "$(LdHasSingleModule)")' >> $@ - @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ - @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ - @echo ',("Merge objects flags", "$(SettingsMergeObjectsFlags)")' >> $@ - @echo ',("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)")' >> $@ - @echo ',("ar command", "$(SettingsArCommand)")' >> $@ - @echo ',("ar flags", "$(ArArgs)")' >> $@ - @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ - @echo ',("ar supports -L", "$(ArSupportsDashL)")' >> $@ - @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ - @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ - @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ + @echo '[("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ - @echo ',("target platform string", "$(TARGETPLATFORM)")' >> $@ - @echo ',("target os", "$(HaskellTargetOs)")' >> $@ - @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ - @echo ',("target word size", "$(TargetWordSize)")' >> $@ - @echo ',("target word big endian", "$(TargetWordBigEndian)")' >> $@ - @echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@ - @echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@ - @echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@ - @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ - @echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@ - @echo ',("LLVM target", "$(LLVMTarget)")' >> $@ - @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ - @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ - @echo ',("LLVM llvm-as command", "$(SettingsLlvmAsCommand)")' >> $@ - @echo ',("LLVM llvm-as flags", "$(SettingsLlvmAsFlags)")' >> $@ - @echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@ - @echo @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ - @echo ',("Tables next to code", "$(TablesNextToCode)")' >> $@ - @echo ',("Leading underscore", "$(LeadingUnderscore)")' >> $@ - @echo ',("Use LibFFI", "$(UseLibffiForAdjustors)")' >> $@ @echo ',("RTS expects libdw", "$(GhcRtsWithLibdw)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ +lib/targets/default.target : config.mk default.target + @rm -f $@ + @echo "Copying the bindist-configured default.target to lib/targets/default.target" + cp default.target $@ + # We need to install binaries relative to libraries. BINARIES = $(wildcard ./bin/*) .PHONY: install_bin_libdir @@ -167,7 +122,7 @@ install_bin_direct: $(INSTALL_PROGRAM) ./bin/* "$(DESTDIR)$(WrapperBinsDir)/" .PHONY: install_lib -install_lib: lib/settings +install_lib: lib/settings lib/targets/default.target @echo "Copying libraries to $(DESTDIR)$(ActualLibsDir)" $(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)" ===================================== hadrian/bindist/config.mk.in ===================================== @@ -133,7 +133,7 @@ INSTALL_DIR = $(INSTALL) -m 755 -d CrossCompiling = @CrossCompiling@ CrossCompilePrefix = @CrossCompilePrefix@ GhcUnregisterised = @Unregisterised@ -EnableDistroToolchain = @SettingsUseDistroMINGW@ +EnableDistroToolchain = @EnableDistroToolchain@ BaseUnitId = @BaseUnitId@ # The THREADED_RTS requires `BaseReg` to be in a register and the @@ -205,31 +205,3 @@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ LeadingUnderscore = @LeadingUnderscore@ LlvmTarget = @LlvmTarget@ - -SettingsCCompilerCommand = @SettingsCCompilerCommand@ -SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ -SettingsCPPCommand = @SettingsCPPCommand@ -SettingsCPPFlags = @SettingsCPPFlags@ -SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ -SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ -SettingsJavaScriptCPPCommand = @SettingsJavaScriptCPPCommand@ -SettingsJavaScriptCPPFlags = @SettingsJavaScriptCPPFlags@ -SettingsCmmCPPCommand = @SettingsCmmCPPCommand@ -SettingsCmmCPPFlags = @SettingsCmmCPPFlags@ -SettingsCmmCPPSupportsG0 = @SettingsCmmCPPSupportsG0@ -SettingsCCompilerFlags = @SettingsCCompilerFlags@ -SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ -SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ -SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ -SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ -SettingsArCommand = @SettingsArCommand@ -SettingsOtoolCommand = @SettingsOtoolCommand@ -SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ -SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsWindresCommand = @SettingsWindresCommand@ -SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsLlcCommand = @SettingsLlcCommand@ -SettingsOptCommand = @SettingsOptCommand@ -SettingsLlvmAsCommand = @SettingsLlvmAsCommand@ -SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -79,7 +79,7 @@ project-git-commit-id = @ProjectGitCommitId@ # generated by configure, to generated being by the build system. Many of these # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -settings-use-distro-mingw = @SettingsUseDistroMINGW@ +settings-use-distro-mingw = @EnableDistroToolchain@ target-has-libm = @TargetHasLibm@ ===================================== hadrian/src/Base.hs ===================================== @@ -151,6 +151,7 @@ ghcLibDeps stage iplace = do , "llvm-passes" , "ghc-interp.js" , "settings" + , "targets" -/- "default.target" , "ghc-usage.txt" , "ghci-usage.txt" , "dyld.mjs" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -10,7 +10,7 @@ import qualified Data.Set as Set import Base import qualified Context import Expression -import Hadrian.Oracles.TextFile (lookupSystemConfig) +import Hadrian.Oracles.TextFile (lookupSystemConfig, getTargetTarget) import Oracles.Flag hiding (arSupportsAtFile, arSupportsDashL) import Oracles.ModuleFiles import Oracles.Setting @@ -24,7 +24,6 @@ import Target import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) -import GHC.Toolchain.Program import GHC.Platform.ArchOS import Settings.Program (ghcWithInterpreter) @@ -263,6 +262,7 @@ generateRules = do let prefix = root -/- stageString stage -/- "lib" go gen file = generate file (semiEmptyTarget (succStage stage)) gen (prefix -/- "settings") %> \out -> go (generateSettings out) out + (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr getTargetTarget) out where file <~+ gen = file %> \out -> generate out emptyTarget gen >> makeExecutable out @@ -425,7 +425,7 @@ bindistRules = do , interpolateSetting "LlvmMinVersion" LlvmMinVersion , interpolateVar "LlvmTarget" $ getTarget tgtLlvmTarget , interpolateSetting "ProjectVersion" ProjectVersion - , interpolateVar "SettingsUseDistroMINGW" $ lookupSystemConfig "settings-use-distro-mingw" + , interpolateVar "EnableDistroToolchain" $ lookupSystemConfig "settings-use-distro-mingw" , interpolateVar "TablesNextToCode" $ yesNo <$> getTarget tgtTablesNextToCode , interpolateVar "TargetHasLibm" $ lookupSystemConfig "target-has-libm" , interpolateVar "TargetPlatform" $ getTarget targetPlatformTriple @@ -483,62 +483,12 @@ generateSettings settingsFile = do let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path settings <- traverse sequence $ - [ ("C compiler command", queryTarget ccPath) - , ("C compiler flags", queryTarget ccFlags) - , ("C++ compiler command", queryTarget cxxPath) - , ("C++ compiler flags", queryTarget cxxFlags) - , ("C compiler link flags", queryTarget clinkFlags) - , ("C compiler supports -no-pie", queryTarget linkSupportsNoPie) - , ("CPP command", queryTarget cppPath) - , ("CPP flags", queryTarget cppFlags) - , ("Haskell CPP command", queryTarget hsCppPath) - , ("Haskell CPP flags", queryTarget hsCppFlags) - , ("JavaScript CPP command", queryTarget jsCppPath) - , ("JavaScript CPP flags", queryTarget jsCppFlags) - , ("C-- CPP command", queryTarget cmmCppPath) - , ("C-- CPP flags", queryTarget cmmCppFlags) - , ("C-- CPP supports -g0", queryTarget cmmCppSupportsG0') - , ("ld supports compact unwind", queryTarget linkSupportsCompactUnwind) - , ("ld supports filelist", queryTarget linkSupportsFilelist) - , ("ld supports single module", queryTarget linkSupportsSingleModule) - , ("ld is GNU ld", queryTarget linkIsGnu) - , ("Merge objects command", queryTarget mergeObjsPath) - , ("Merge objects flags", queryTarget mergeObjsFlags) - , ("Merge objects supports response files", queryTarget mergeObjsSupportsResponseFiles') - , ("ar command", queryTarget arPath) - , ("ar flags", queryTarget arFlags) - , ("ar supports at file", queryTarget arSupportsAtFile') - , ("ar supports -L", queryTarget arSupportsDashL') - , ("ranlib command", queryTarget ranlibPath) - , ("otool command", queryTarget otoolPath) - , ("install_name_tool command", queryTarget installNameToolPath) - , ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me. - , ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) - , ("target platform string", queryTarget targetPlatformTriple) - , ("target os", queryTarget (show . archOS_OS . tgtArchOs)) - , ("target arch", queryTarget (show . archOS_arch . tgtArchOs)) - , ("target word size", queryTarget wordSize) - , ("target word big endian", queryTarget isBigEndian) - , ("target has GNU nonexec stack", queryTarget (yesNo . Toolchain.tgtSupportsGnuNonexecStack)) - , ("target has .ident directive", queryTarget (yesNo . Toolchain.tgtSupportsIdentDirective)) - , ("target has subsections via symbols", queryTarget (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols)) + [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("target has libm", expr $ lookupSystemConfig "target-has-libm") - , ("Unregisterised", queryTarget (yesNo . tgtUnregisterised)) - , ("LLVM target", queryTarget tgtLlvmTarget) - , ("LLVM llc command", queryTarget llcPath) - , ("LLVM opt command", queryTarget optPath) - , ("LLVM llvm-as command", queryTarget llvmAsPath) - , ("LLVM llvm-as flags", queryTarget llvmAsFlags) - , ("Use inplace MinGW toolchain", expr $ lookupSystemConfig "settings-use-distro-mingw") - , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("Tables next to code", queryTarget (yesNo . tgtTablesNextToCode)) - , ("Leading underscore", queryTarget (yesNo . tgtSymbolsHaveLeadingUnderscore)) - , ("Use LibFFI", expr $ yesNo <$> useLibffiForAdjustors) , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) @@ -550,40 +500,6 @@ generateSettings settingsFile = do ("[" ++ showTuple s) : ((\s' -> "," ++ showTuple s') <$> ss) ++ ["]"] - where - ccPath = prgPath . ccProgram . tgtCCompiler - ccFlags = escapeArgs . prgFlags . ccProgram . tgtCCompiler - cxxPath = prgPath . cxxProgram . tgtCxxCompiler - cxxFlags = escapeArgs . prgFlags . cxxProgram . tgtCxxCompiler - clinkFlags = escapeArgs . prgFlags . ccLinkProgram . tgtCCompilerLink - linkSupportsNoPie = yesNo . ccLinkSupportsNoPie . tgtCCompilerLink - cppPath = prgPath . cppProgram . tgtCPreprocessor - cppFlags = escapeArgs . prgFlags . cppProgram . tgtCPreprocessor - hsCppPath = prgPath . hsCppProgram . tgtHsCPreprocessor - hsCppFlags = escapeArgs . prgFlags . hsCppProgram . tgtHsCPreprocessor - jsCppPath = maybe "" (prgPath . jsCppProgram) . tgtJsCPreprocessor - jsCppFlags = maybe "" (escapeArgs . prgFlags . jsCppProgram) . tgtJsCPreprocessor - cmmCppPath = prgPath . cmmCppProgram . tgtCmmCPreprocessor - cmmCppFlags = escapeArgs . prgFlags . cmmCppProgram . tgtCmmCPreprocessor - cmmCppSupportsG0' = yesNo . cmmCppSupportsG0 . tgtCmmCPreprocessor - mergeObjsPath = maybe "" (prgPath . mergeObjsProgram) . tgtMergeObjs - mergeObjsFlags = maybe "" (escapeArgs . prgFlags . mergeObjsProgram) . tgtMergeObjs - linkSupportsSingleModule = yesNo . ccLinkSupportsSingleModule . tgtCCompilerLink - linkSupportsFilelist = yesNo . ccLinkSupportsFilelist . tgtCCompilerLink - linkSupportsCompactUnwind = yesNo . ccLinkSupportsCompactUnwind . tgtCCompilerLink - linkIsGnu = yesNo . ccLinkIsGnu . tgtCCompilerLink - llcPath = maybe "" prgPath . tgtLlc - optPath = maybe "" prgPath . tgtOpt - llvmAsPath = maybe "" prgPath . tgtLlvmAs - llvmAsFlags = escapeArgs . maybe [] prgFlags . tgtLlvmAs - arPath = prgPath . arMkArchive . tgtAr - arFlags = escapeArgs . prgFlags . arMkArchive . tgtAr - arSupportsAtFile' = yesNo . arSupportsAtFile . tgtAr - arSupportsDashL' = yesNo . arSupportsDashL . tgtAr - otoolPath = maybe "" prgPath . tgtOtool - installNameToolPath = maybe "" prgPath . tgtInstallNameTool - ranlibPath = maybe "" (prgPath . ranlibProgram) . tgtRanlib - mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs isBigEndian, wordSize :: Toolchain.Target -> String isBigEndian = yesNo . (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness ===================================== libraries/ghc-boot/GHC/Settings/Utils.hs ===================================== @@ -10,6 +10,8 @@ import GHC.BaseDir import GHC.Platform.ArchOS import System.FilePath +import GHC.Toolchain.Target + maybeRead :: Read a => String -> Maybe a maybeRead str = case reads str of [(x, "")] -> Just x @@ -36,19 +38,17 @@ type RawSettings = Map String String -- | Read target Arch/OS from the settings getTargetArchOS - :: FilePath -- ^ Settings filepath (for error messages) - -> RawSettings -- ^ Raw settings file contents - -> Either String ArchOS -getTargetArchOS settingsFile settings = - ArchOS <$> readRawSetting settingsFile settings "target arch" - <*> readRawSetting settingsFile settings "target os" + :: Target -- ^ The 'Target' from which to read the 'ArchOS' + -> ArchOS +getTargetArchOS target = tgtArchOs target getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath getGlobalPackageDb settingsFile settings = do rel_db <- getRawSetting settingsFile settings "Relative Global Package DB" return (dropFileName settingsFile rel_db) - +-------------------------------------------------------------------------------- +-- lib/settings getRawSetting :: FilePath -> RawSettings -> String -> Either String String @@ -70,10 +70,3 @@ getRawBooleanSetting settingsFile settings key = do "NO" -> Right False xs -> Left $ "Bad value for " ++ show key ++ ": " ++ show xs -readRawSetting - :: (Show a, Read a) => FilePath -> RawSettings -> String -> Either String a -readRawSetting settingsFile settings key = case Map.lookup key settings of - Just xs -> case maybeRead xs of - Just v -> Right v - Nothing -> Left $ "Failed to read " ++ show key ++ " value " ++ show xs - Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -82,7 +82,8 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.6, deepseq >= 1.4 && < 1.6, - ghc-platform >= 0.1, + ghc-platform >= 0.1, + ghc-toolchain >= 0.1 -- reexport modules from ghc-boot-th so that packages -- don't have to import all of ghc-boot and ghc-boot-th. ===================================== libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Internal.ResponseFile ( getArgsWithResponseFiles, unescapeArgs, - escapeArgs, + escapeArgs, escapeArg, expandResponse ) where ===================================== m4/fp_settings.m4 deleted ===================================== @@ -1,171 +0,0 @@ -dnl Note [How we configure the bundled windows toolchain] -dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -dnl As per Note [tooldir: How GHC finds mingw on Windows], when using the -dnl bundled windows toolchain, the GHC settings file must refer to the -dnl toolchain through a path relative to $tooldir (binary distributions on -dnl Windows should work without configure, so the paths must be relative to the -dnl installation). However, hadrian expects the configured toolchain to use -dnl full paths to the executable. -dnl -dnl This is how the bundled windows toolchain is configured, to define the -dnl toolchain with paths to the executables, while still writing into GHC -dnl settings the paths relative to $tooldir: -dnl -dnl * If using the bundled toolchain, FP_SETUP_WINDOWS_TOOLCHAIN will be invoked -dnl -dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths -dnl to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc) -dnl -dnl * Later on, in FP_SETTINGS, we substitute occurrences of the path to the -dnl mingw tooldir by $tooldir (see SUBST_TOOLDIR). -dnl The reason is the Settings* variants of toolchain variables are used by the bindist configure to -dnl create the settings file, which needs the windows bundled toolchain to be relative to $tooldir. -dnl -dnl * Finally, hadrian will also substitute the mingw prefix by $tooldir before writing the toolchain to the settings file (see generateSettings) -dnl -dnl The ghc-toolchain program isn't concerned with any of these complications: -dnl it is passed either the full paths to the toolchain executables, or the bundled -dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain -dnl will, as always, output target files with full paths to the executables. -dnl -dnl Hadrian accounts for this as it does for the toolchain executables -dnl configured by configure -- in fact, hadrian doesn't need to know whether -dnl the toolchain description file was generated by configure or by -dnl ghc-toolchain. - -# SUBST_TOOLDIR -# ---------------------------------- -# $1 - the variable where to search for occurrences of the path to the -# inplace mingw, and update by substituting said occurrences by -# the value of $mingw_install_prefix, where the mingw toolchain will be at -# install time -# -# See Note [How we configure the bundled windows toolchain] -AC_DEFUN([SUBST_TOOLDIR], -[ - dnl and Note [How we configure the bundled windows toolchain] - $1=`echo "$$1" | sed 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g'` -]) - -# FP_SETTINGS -# ---------------------------------- -# Set the variables used in the settings file -AC_DEFUN([FP_SETTINGS], -[ - SettingsUseDistroMINGW="$EnableDistroToolchain" - - SettingsCCompilerCommand="$CC" - SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" - SettingsCxxCompilerCommand="$CXX" - SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" - SettingsCPPCommand="$CPPCmd" - SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" - SettingsHaskellCPPCommand="$HaskellCPPCmd" - SettingsHaskellCPPFlags="$HaskellCPPArgs" - SettingsJavaScriptCPPCommand="$JavaScriptCPPCmd" - SettingsJavaScriptCPPFlags="$JavaScriptCPPArgs" - SettingsCmmCPPCommand="$CmmCPPCmd" - SettingsCmmCPPFlags="$CmmCPPArgs" - SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsArCommand="$ArCmd" - SettingsRanlibCommand="$RanlibCmd" - SettingsMergeObjectsCommand="$MergeObjsCmd" - SettingsMergeObjectsFlags="$MergeObjsArgs" - - AS_CASE( - ["$CmmCPPSupportsG0"], - [True], [SettingsCmmCPPSupportsG0=YES], - [False], [SettingsCmmCPPSupportsG0=NO], - [AC_MSG_ERROR(Unknown CPPSupportsG0 value $CmmCPPSupportsG0)] - ) - - if test -z "$WindresCmd"; then - SettingsWindresCommand="/bin/false" - else - SettingsWindresCommand="$WindresCmd" - fi - - # LLVM backend tools - SettingsLlcCommand="$LlcCmd" - SettingsOptCommand="$OptCmd" - SettingsLlvmAsCommand="$LlvmAsCmd" - SettingsLlvmAsFlags="$LlvmAsFlags" - - if test "$EnableDistroToolchain" = "YES"; then - # If the user specified --enable-distro-toolchain then we just use the - # executable names, not paths. - SettingsCCompilerCommand="$(basename $SettingsCCompilerCommand)" - SettingsHaskellCPPCommand="$(basename $SettingsHaskellCPPCommand)" - SettingsCmmCPPCommand="$(basename $SettingsCmmCPPCommand)" - SettingsJavaScriptCPPCommand="$(basename $SettingsJavaScriptCPPCommand)" - SettingsLdCommand="$(basename $SettingsLdCommand)" - SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" - SettingsArCommand="$(basename $SettingsArCommand)" - SettingsWindresCommand="$(basename $SettingsWindresCommand)" - SettingsLlcCommand="$(basename $SettingsLlcCommand)" - SettingsOptCommand="$(basename $SettingsOptCommand)" - SettingsLlvmAsCommand="$(basename $SettingsLlvmAsCommand)" - fi - - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then - # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. - # We need to issue a substitution to use $tooldir, - # See Note [tooldir: How GHC finds mingw on Windows] - SUBST_TOOLDIR([SettingsCCompilerCommand]) - SUBST_TOOLDIR([SettingsCCompilerFlags]) - SUBST_TOOLDIR([SettingsCxxCompilerCommand]) - SUBST_TOOLDIR([SettingsCxxCompilerFlags]) - SUBST_TOOLDIR([SettingsCCompilerLinkFlags]) - SUBST_TOOLDIR([SettingsCPPCommand]) - SUBST_TOOLDIR([SettingsCPPFlags]) - SUBST_TOOLDIR([SettingsHaskellCPPCommand]) - SUBST_TOOLDIR([SettingsHaskellCPPFlags]) - SUBST_TOOLDIR([SettingsCmmCPPCommand]) - SUBST_TOOLDIR([SettingsCmmCPPFlags]) - SUBST_TOOLDIR([SettingsJavaScriptCPPCommand]) - SUBST_TOOLDIR([SettingsJavaScriptCPPFlags]) - SUBST_TOOLDIR([SettingsMergeObjectsCommand]) - SUBST_TOOLDIR([SettingsMergeObjectsFlags]) - SUBST_TOOLDIR([SettingsArCommand]) - SUBST_TOOLDIR([SettingsRanlibCommand]) - SUBST_TOOLDIR([SettingsWindresCommand]) - SUBST_TOOLDIR([SettingsLlcCommand]) - SUBST_TOOLDIR([SettingsOptCommand]) - SUBST_TOOLDIR([SettingsLlvmAsCommand]) - SUBST_TOOLDIR([SettingsLlvmAsFlags]) - fi - - # Mac-only tools - SettingsOtoolCommand="$OtoolCmd" - SettingsInstallNameToolCommand="$InstallNameToolCmd" - - SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" - - AC_SUBST(SettingsCCompilerCommand) - AC_SUBST(SettingsCxxCompilerCommand) - AC_SUBST(SettingsCPPCommand) - AC_SUBST(SettingsCPPFlags) - AC_SUBST(SettingsHaskellCPPCommand) - AC_SUBST(SettingsHaskellCPPFlags) - AC_SUBST(SettingsCmmCPPCommand) - AC_SUBST(SettingsCmmCPPFlags) - AC_SUBST(SettingsCmmCPPSupportsG0) - AC_SUBST(SettingsJavaScriptCPPCommand) - AC_SUBST(SettingsJavaScriptCPPFlags) - AC_SUBST(SettingsCCompilerFlags) - AC_SUBST(SettingsCxxCompilerFlags) - AC_SUBST(SettingsCCompilerLinkFlags) - AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) - AC_SUBST(SettingsArCommand) - AC_SUBST(SettingsRanlibCommand) - AC_SUBST(SettingsOtoolCommand) - AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsLlcCommand) - AC_SUBST(SettingsOptCommand) - AC_SUBST(SettingsLlvmAsCommand) - AC_SUBST(SettingsLlvmAsFlags) - AC_SUBST(SettingsUseDistroMINGW) -]) ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -77,6 +77,7 @@ AC_DEFUN([FP_INSTALL_WINDOWS_TOOLCHAIN],[ # $2 the location that the windows toolchain will be installed in relative to the libdir AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ + # TODO: UPDATE COMMENT # N.B. The parameters which get plopped in the `settings` file used by the # resulting compiler are computed in `FP_SETTINGS`. Specifically, we use # $$topdir-relative paths instead of fullpaths to the toolchain, by replacing ===================================== m4/subst_tooldir.m4 ===================================== @@ -0,0 +1,45 @@ +dnl Note [How we configure the bundled windows toolchain] +dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +dnl As per Note [tooldir: How GHC finds mingw on Windows], when using the +dnl bundled windows toolchain, the GHC settings file must refer to the +dnl toolchain through a path relative to $tooldir (binary distributions on +dnl Windows should work without configure, so the paths must be relative to the +dnl installation). However, hadrian expects the configured toolchain to use +dnl full paths to the executable. +dnl +dnl This is how the bundled windows toolchain is configured, to define the +dnl toolchain with paths to the executables, while still writing into GHC +dnl settings the paths relative to $tooldir: +dnl +dnl * If using the bundled toolchain, FP_SETUP_WINDOWS_TOOLCHAIN will be invoked +dnl +dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths +dnl to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc) +dnl +dnl * Later on, at the end of distrib/configure.ac, we substitute occurrences of the path to the +dnl mingw tooldir by $tooldir (see SUBST_TOOLDIR). +dnl The reason is the Settings* variants of toolchain variables are used by the bindist configure to +dnl create the settings file, which needs the windows bundled toolchain to be relative to $tooldir. +dnl +dnl The ghc-toolchain program isn't concerned with any of these complications: +dnl it is passed either the full paths to the toolchain executables, or the bundled +dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain +dnl will, as always, output target files with full paths to the executables. +dnl +dnl Hadrian accounts for this as it does for the toolchain executables +dnl configured by configure -- in fact, hadrian doesn't need to know whether +dnl the toolchain description file was generated by configure or by +dnl ghc-toolchain. + +# SUBST_TOOLDIR +# ---------------------------------- +# $1 - the filepath where to search for occurrences of the path to the +# inplace mingw, and update by substituting said occurrences by +# the value of $mingw_install_prefix, where the mingw toolchain will be at +# install time +# +# See Note [How we configure the bundled windows toolchain] +AC_DEFUN([SUBST_TOOLDIR], +[ + sed -i.bkp $1 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g' +]) ===================================== mk/hsc2hs.in ===================================== @@ -1,6 +1,6 @@ -HSC2HS_C="@SettingsCCompilerFlags@" +HSC2HS_C="@CONF_CC_OPTS_STAGE2@" -HSC2HS_L="@SettingsCCompilerLinkFlags@" +HSC2HS_L="@CONF_GCC_LINKER_OPTS_STAGE2@" tflag="--template=$libdir/template-hsc.h" Iflag="-I$includedir/include/" ===================================== testsuite/tests/ghc-api/T20757.hs ===================================== @@ -3,4 +3,4 @@ module Main where import GHC.SysTools.BaseDir main :: IO () -main = findToolDir False "/" >>= print +main = findToolDir "/" >>= print ===================================== testsuite/tests/ghc-api/settings-escape/T24265.hs ===================================== @@ -16,6 +16,13 @@ import System.Environment import System.IO (hPutStrLn, stderr) import System.Exit (exitWith, ExitCode(ExitFailure)) +import GHC.Toolchain +import GHC.Toolchain.Program +import GHC.Toolchain.Tools.Cc +import GHC.Toolchain.Tools.Cpp +import GHC.Toolchain.Tools.Cxx +import GHC.Toolchain.Lens + -- Precondition: this test case must be executed in a directory with a space. -- -- First we get the current settings file and amend it with extra arguments that we *know* @@ -30,35 +37,29 @@ main :: IO () main = do libdir:_args <- getArgs - (rawSettingOpts, originalSettings) <- runGhc (Just libdir) $ do + (rawSettingOpts, rawTargetOpts, originalSettings) <- runGhc (Just libdir) $ do dflags <- hsc_dflags <$> getSession - pure (rawSettings dflags, settings dflags) + pure (rawSettings dflags, rawTarget dflags, settings dflags) top_dir <- makeAbsolute "./ghc-install-folder/lib with spaces" - let argsWithSpaces = "\"-some option\" -some\\ other" - numberOfExtraArgs = length $ unescapeArgs argsWithSpaces - -- These are all options that can have multiple 'String' or 'Option' values. - -- We explicitly do not add 'C compiler link flags' here, as 'initSettings' - -- already adds the options of "C compiler flags" to this config field. - multipleArguments = Set.fromList - [ "Haskell CPP flags" - , "JavaScript CPP flags" - , "C-- CPP flags" - , "C compiler flags" - , "C++ compiler flags" - , "CPP flags" - , "Merge objects flags" + let argsWithSpaces l = over l (++["-some option", "-some\\ other"]) + numberOfExtraArgs = 2 + -- Test it on a handfull of list of flags + multipleArguments = + [ _tgtHsCpp % _hsCppProg % _prgFlags -- "Haskell CPP flags" + , _tgtCC % _ccProgram % _prgFlags -- "C compiler flags" + , _tgtCxx % _cxxProgram % _prgFlags -- "C++ compiler flags" + , _tgtCpp % _cppProg % _prgFlags -- "CPP flags" ] - let rawSettingOptsWithExtraArgs = - map (\(name, args) -> if Set.member name multipleArguments - then (name, args ++ " " ++ argsWithSpaces) - else (name, args)) rawSettingOpts + targetWithExtraArgs = foldr argsWithSpaces rawTargetOpts multipleArguments -- write out the modified settings. We try to keep it legible writeFile (top_dir ++ "/settings") $ - "[" ++ (intercalate "\n," (map show rawSettingOptsWithExtraArgs)) ++ "]" + "[" ++ (intercalate "\n," (map show rawSettingOpts)) ++ "]" + writeFile (top_dir ++ "/targets/default.target") $ + show targetWithExtraArgs settingsm <- runExceptT $ initSettings top_dir @@ -113,12 +114,6 @@ main = do -- Setting 'Haskell CPP flags' contains '$topdir' reference. -- Resolving those while containing spaces, should not introduce more options. recordSetting "Haskell CPP flags" (map showOpt . snd . toolSettings_pgm_P . sToolSettings) - -- Setting 'JavaScript CPP flags' contains '$topdir' reference. - -- Resolving those while containing spaces, should not introduce more options. - recordSetting "JavaScript CPP flags" (map showOpt . snd . toolSettings_pgm_JSP . sToolSettings) - -- Setting 'C-- CPP flags' contains '$topdir' reference. - -- Resolving those while containing spaces, should not introduce more options. - recordSetting "C-- CPP flags" (map showOpt . snd . toolSettings_pgm_CmmP . sToolSettings) -- Setting 'C compiler flags' contains strings with spaces. -- GHC should not split these by word. recordSetting "C compiler flags" (toolSettings_opt_c . sToolSettings) @@ -133,10 +128,6 @@ main = do -- Setting 'CPP flags' contains strings with spaces. -- GHC should not split these by word. recordSetting "CPP flags" (map showOpt . snd . toolSettings_pgm_cpp . sToolSettings) - -- Setting 'Merge objects flags' contains strings with spaces. - -- GHC should not split these by word. - -- If 'Nothing', ignore this test, otherwise the same assertion holds as before. - recordSettingM "Merge objects flags" (fmap (map showOpt . snd) . toolSettings_pgm_lm . sToolSettings) -- Setting 'C compiler command' contains '$topdir' reference. -- Spaces in the final filepath should not be escaped. recordFpSetting "C compiler" (toolSettings_pgm_c . sToolSettings) ===================================== testsuite/tests/ghc-api/settings-escape/T24265.stderr ===================================== @@ -1,9 +1,5 @@ === 'Haskell CPP flags' contains 2 new entries: True Contains spaces: True -=== 'JavaScript CPP flags' contains 2 new entries: True - Contains spaces: True -=== 'C-- CPP flags' contains 2 new entries: True - Contains spaces: True === 'C compiler flags' contains 2 new entries: True Contains spaces: True === 'C compiler link flags' contains 2 new entries: True @@ -12,5 +8,4 @@ Contains spaces: True === 'CPP flags' contains 2 new entries: True Contains spaces: True -=== 'Merge objects flags' contains expected entries: True === FilePath 'C compiler' contains escaped spaces: False ===================================== testsuite/tests/ghc-api/settings-escape/ghc-install-folder/lib with spaces/targets/.gitkeep ===================================== ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -96,6 +96,8 @@ import System.Posix hiding (fdToHandle) import qualified System.Info(os) #endif +import GHC.Toolchain.Target + -- | Short-circuit 'any' with a \"monadic predicate\". anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool anyM _ [] = return False @@ -583,9 +585,20 @@ readFromSettingsFile settingsFile f = do -- It's excusable to not have a settings file (for now at -- least) but completely inexcusable to have a malformed one. Nothing -> Left $ "Can't parse settings file " ++ show settingsFile - case f settingsFile mySettings of - Right archOS -> Right archOS - Left e -> Left e + f settingsFile mySettings + +readFromTargetFile :: FilePath + -> (Target -> b) + -> IO (Either String b) +readFromTargetFile targetFile f = do + targetStr <- readFile targetFile + pure $ do + target <- case maybeReadFuzzy targetStr of + Just t -> Right t + -- It's excusable to not have a settings file (for now at + -- least) but completely inexcusable to have a malformed one. + Nothing -> Left $ "Can't parse .target file " ++ show targetFile + Right (f target) getPkgDatabases :: Verbosity -> GhcPkg.DbOpenMode mode DbModifySelector @@ -618,6 +631,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do Nothing -> die err_msg Just dir -> do -- Look for where it is given in the settings file, if marked there. + -- See Note [Settings file] about this file, and why we need GHC to share it with us. let settingsFile = dir "settings" exists_settings_file <- doesFileExist settingsFile erel_db <- @@ -652,16 +666,15 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do case [ f | FlagUserConfig f <- my_flags ] of _ | no_user_db -> return Nothing [] -> do - -- See Note [Settings file] about this file, and why we need GHC to share it with us. - let settingsFile = top_dir "settings" - exists_settings_file <- doesFileExist settingsFile + let targetFile = top_dir "targets" "default.target" + exists_settings_file <- doesFileExist targetFile targetArchOS <- case exists_settings_file of False -> do - warn $ "WARNING: settings file doesn't exist " ++ show settingsFile + warn $ "WARNING: target file doesn't exist " ++ show targetFile warn "cannot know target platform so guessing target == host (native compiler)." pure hostPlatformArchOS True -> - readFromSettingsFile settingsFile getTargetArchOS >>= \case + readFromTargetFile targetFile getTargetArchOS >>= \case Right v -> pure v Left e -> die e ===================================== utils/ghc-pkg/ghc-pkg.cabal.in ===================================== @@ -29,6 +29,7 @@ Executable ghc-pkg Cabal-syntax, binary, ghc-boot, + ghc-toolchain, bytestring if !os(windows) Build-Depends: unix ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -534,4 +534,3 @@ mkTarget opts = do } return t ---- ROMES:TODO: fp_settings.m4 in general which I don't think was ported completely (e.g. the basenames and windows llvm-XX and such) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -7,6 +7,9 @@ module GHC.Toolchain.Target , WordSize(..), wordSize2Bytes + -- ** Lenses + , _tgtCC, _tgtCxx, _tgtCpp, _tgtHsCpp + -- * Re-exports , ByteOrder(..) ) where @@ -137,3 +140,29 @@ instance Show Target where , ", tgtInstallNameTool = " ++ show tgtInstallNameTool , "}" ] + +-------------------------------------------------------------------------------- +-- Lenses +-------------------------------------------------------------------------------- + +_tgtCC :: Lens Target Cc +_tgtCC = Lens tgtCCompiler (\x o -> o {tgtCCompiler = x}) + +_tgtCxx :: Lens Target Cxx +_tgtCxx = Lens tgtCxxCompiler (\x o -> o {tgtCxxCompiler = x}) + +_tgtCpp :: Lens Target Cpp +_tgtCpp = Lens tgtCPreprocessor (\x o -> o {tgtCPreprocessor = x}) + +_tgtHsCpp :: Lens Target HsCpp +_tgtHsCpp = Lens tgtHsCPreprocessor (\x o -> o {tgtHsCPreprocessor = x}) + +_tgtJsCpp :: Lens Target (Maybe JsCpp) +_tgtJsCpp = Lens tgtJsCPreprocessor (\x o -> o {tgtJsCPreprocessor = x}) + +_tgtCmmCpp :: Lens Target CmmCpp +_tgtCmmCpp = Lens tgtCmmCPreprocessor (\x o -> o {tgtCmmCPreprocessor = x}) + +_tgtMergeObjs :: Lens Target (Maybe MergeObjs) +_tgtMergeObjs = Lens tgtMergeObjs (\x o -> o {tgtMergeObjs = x}) + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -5,6 +5,9 @@ module GHC.Toolchain.Tools.Cpp , Cpp(..), findCpp , JsCpp(..), findJsCpp , CmmCpp(..), findCmmCpp + + -- * Lenses + , _cppProg, _hsCppProg, _jsCppProg, _cmmCppProg ) where import Control.Monad @@ -188,3 +191,18 @@ findCpp progOpt cc = checking "for C preprocessor" $ do let cppProgram = addFlagIfNew "-E" cpp2 return Cpp{cppProgram} +-------------------------------------------------------------------------------- +-- Lenses +-------------------------------------------------------------------------------- + +_cppProg :: Lens Cpp Program +_cppProg = Lens cppProgram (\x o -> o{cppProgram = x}) + +_hsCppProg :: Lens HsCpp Program +_hsCppProg = Lens hsCppProgram (\x o -> o{hsCppProgram = x}) + +_jsCppProg :: Lens JsCpp Program +_jsCppProg = Lens jsCppProgram (\x o -> o{jsCppProgram = x}) + +_cmmCppProg :: Lens CmmCpp Program +_cmmCppProg = Lens cmmCppProgram (\x o -> o{cmmCppProgram = x}) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -4,7 +4,7 @@ module GHC.Toolchain.Tools.Cxx ( Cxx(..) , findCxx -- * Helpful utilities - , compileCxx + , compileCxx, _cxxProgram ) where import System.FilePath View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e74adc114542a95a1b6cf1653b01393... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e74adc114542a95a1b6cf1653b01393... You're receiving this email because of your account on gitlab.haskell.org.