Commit bfccd832 authored by John Ericson's avatar John Ericson Committed by Marge Bot

Inline `Settings` into `DynFlags`

After the previous commit, `Settings` is just a thin wrapper around
other groups of settings. While `Settings` is used by GHC-the-executable
to initalize `DynFlags`, in principle another consumer of
GHC-the-library could initialize `DynFlags` a different way. It
therefore doesn't make sense for `DynFlags` itself (library code) to
separate the settings that typically come from `Settings` from the
settings that typically don't.
parent ace2e335
Pipeline #6204 passed with stages
in 419 minutes and 51 seconds
......@@ -1162,7 +1162,7 @@ pprCLabel dynFlags (AsmTempLabel u)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u
pprCLabel dynFlags (AsmTempDerivedLabel l suf)
| sGhcWithNativeCodeGen $ settings dynFlags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= ptext (asmTempLabelPrefix $ targetPlatform dynFlags)
<> case l of AsmTempLabel u -> pprUniqueAlways u
LocalBlockLabel u -> pprUniqueAlways u
......@@ -1170,15 +1170,15 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf)
<> ftext suf
pprCLabel dynFlags (DynamicLinkerLabel info lbl)
| sGhcWithNativeCodeGen $ settings dynFlags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl
pprCLabel dynFlags PicBaseLabel
| sGhcWithNativeCodeGen $ settings dynFlags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= text "1b"
pprCLabel dynFlags (DeadStripPreventer lbl)
| sGhcWithNativeCodeGen $ settings dynFlags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
=
{-
`lbl` can be temp one but we need to ensure that dsp label will stay
......@@ -1190,18 +1190,18 @@ pprCLabel dynFlags (DeadStripPreventer lbl)
<> pprCLabel dynFlags lbl <> text "_dsp"
pprCLabel dynFlags (StringLitLabel u)
| sGhcWithNativeCodeGen $ settings dynFlags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= pprUniqueAlways u <> ptext (sLit "_str")
pprCLabel dynFlags lbl
= getPprStyle $ \ sty ->
if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty
if platformMisc_ghcWithNativeCodeGen (platformMisc dynFlags) && asmStyle sty
then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl
else pprCLbl lbl
maybe_underscore :: DynFlags -> SDoc -> SDoc
maybe_underscore dynFlags doc =
if sLeadingUnderscore $ settings dynFlags
if platformMisc_leadingUnderscore $ platformMisc dynFlags
then pp_cSEP <> doc
else doc
......
......@@ -531,7 +531,7 @@ funInfoArity dflags iptr
| otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
, oFFSET_StgFunInfoExtraFwd_arity dflags )
pc = sPlatformConstants (settings dflags)
pc = platformConstants dflags
-----------------------------------------------------------------------------
--
......
......@@ -335,22 +335,22 @@ data ForeignHint
rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
rEP_CostCentreStack_mem_alloc dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))
where pc = sPlatformConstants (settings dflags)
where pc = platformConstants dflags
rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))
where pc = sPlatformConstants (settings dflags)
where pc = platformConstants dflags
rEP_StgEntCounter_allocs :: DynFlags -> CmmType
rEP_StgEntCounter_allocs dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
where pc = sPlatformConstants (settings dflags)
where pc = platformConstants dflags
rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
where pc = sPlatformConstants (settings dflags)
where pc = platformConstants dflags
-------------------------------------------------------------------------
{- Note [Signed vs unsigned]
......
......@@ -541,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
| otherwise = text ('a':show n)
-- generate a libffi-style stub if this is a "wrapper" and libffi is enabled
libffi = sLibFFI (settings dflags) && isNothing maybe_target
libffi = platformMisc_libFFI (platformMisc dflags) && isNothing maybe_target
type_string
-- libffi needs to know the result type too:
......
......@@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls =
-- Add directories to library search paths, this only has an effect
-- on Windows. On Unix OSes this function is a NOP.
let all_paths = let paths = takeDirectory (fst $ sPgm_c $ settings dflags)
let all_paths = let paths = takeDirectory (fst $ pgm_c dflags)
: framework_paths
++ lib_paths_base
++ [ takeDirectory dll | DLLPath dll <- libspecs ]
......
......@@ -155,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath
-> Stream IO RawCmmGroup ()
-> IO ()
outputAsm dflags this_mod location filenm cmm_stream
| sGhcWithNativeCodeGen $ settings dflags
| platformMisc_ghcWithNativeCodeGen $ platformMisc dflags
= do ncg_uniqs <- mkSplitUniqSupply 'n'
debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
......@@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs
-- wrapper code mentions the ffi_arg type, which comes from ffi.h
ffi_includes
| sLibFFI $ settings dflags = "#include \"ffi.h\"\n"
| platformMisc_libFFI $ platformMisc dflags = "#include \"ffi.h\"\n"
| otherwise = ""
stub_h_file_exists
......
......@@ -59,6 +59,7 @@ import LlvmCodeGen ( llvmFixupAsm )
import MonadUtils
import Platform
import TcRnTypes
import ToolSettings
import Hooks
import qualified GHC.LanguageExtensions as LangExt
import FileCleanup
......@@ -373,7 +374,7 @@ link ghcLink dflags
= lookupHook linkHook l dflags ghcLink dflags
where
l LinkInMemory _ _ _
= if sGhcWithInterpreter $ settings dflags
= if platformMisc_ghcWithInterpreter $ platformMisc dflags
then -- Not Linking...(demand linker will do the job)
return Succeeded
else panicBadLink LinkInMemory
......@@ -1605,7 +1606,7 @@ linkBinary = linkBinary' False
linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary' staticLink dflags o_files dep_packages = do
let platform = targetPlatform dflags
mySettings = settings dflags
toolSettings' = toolSettings dflags
verbFlags = getVerbFlags dflags
output_fn = exeFileName staticLink dflags
......@@ -1761,7 +1762,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
-- like
-- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
-- on x86.
++ (if sLdSupportsCompactUnwind mySettings &&
++ (if toolSettings_ldSupportsCompactUnwind toolSettings' &&
not staticLink &&
(platformOS platform == OSDarwin) &&
case platformArch platform of
......@@ -1785,7 +1786,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
then ["-Wl,-read_only_relocs,suppress"]
else [])
++ (if sLdIsGnuLd mySettings &&
++ (if toolSettings_ldIsGnuLd toolSettings' &&
not (gopt Opt_WholeArchiveHsLibs dflags)
then ["-Wl,--gc-sections"]
else [])
......@@ -1912,7 +1913,7 @@ linkStaticLib dflags o_files dep_packages = do
<$> (Archive <$> mapM loadObj modules)
<*> mapM loadAr archives
if sLdIsGnuLd (settings dflags)
if toolSettings_ldIsGnuLd (toolSettings dflags)
then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
......@@ -2085,15 +2086,15 @@ none of this can be used in that case.
joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles dflags o_files output_fn = do
let mySettings = settings dflags
ldIsGnuLd = sLdIsGnuLd mySettings
let toolSettings' = toolSettings dflags
ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
osInfo = platformOS (targetPlatform dflags)
ld_r args cc = SysTools.runLink dflags ([
SysTools.Option "-nostdlib",
SysTools.Option "-Wl,-r"
]
-- See Note [No PIE while linking] in DynFlags
++ (if sGccSupportsNoPie mySettings
++ (if toolSettings_ccSupportsNoPie toolSettings'
then [SysTools.Option "-no-pie"]
else [])
......@@ -2124,7 +2125,7 @@ joinObjectFiles dflags o_files output_fn = do
-- suppress the generation of the .note.gnu.build-id section,
-- which we don't need and sometimes causes ld to emit a
-- warning:
ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"]
ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"]
| otherwise = []
ccInfo <- getCompilerInfo dflags
......@@ -2135,7 +2136,7 @@ joinObjectFiles dflags o_files output_fn = do
let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files
writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
ld_r [SysTools.FileOption "" script] ccInfo
else if sLdSupportsFilelist mySettings
else if toolSettings_ldSupportsFilelist toolSettings'
then do
filelist <- newTempName dflags TFL_CurrentModule "filelist"
writeFile filelist $ unlines o_files
......
......@@ -147,8 +147,9 @@ module DynFlags (
GhcNameVersion(..),
FileSettings(..),
PlatformMisc(..),
targetPlatform, programName, projectVersion,
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
settings,
programName, projectVersion,
ghcUsagePath, ghciUsagePath, topDir, tmpDir,
versionedAppDir,
extraGccViaCFlags, systemPackageConfig,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T,
......@@ -943,7 +944,16 @@ data DynFlags = DynFlags {
ghcMode :: GhcMode,
ghcLink :: GhcLink,
hscTarget :: HscTarget,
settings :: Settings,
-- formerly Settings
ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion,
fileSettings :: {-# UNPACK #-} !FileSettings,
targetPlatform :: Platform, -- Filled in by SysTools
toolSettings :: {-# UNPACK #-} !ToolSettings,
platformMisc :: {-# UNPACK #-} !PlatformMisc,
platformConstants :: PlatformConstants,
rawSettings :: [(String, String)],
integerLibrary :: IntegerLibrary,
-- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden
-- by GHC-API users. See Note [The integer library] in PrelNames
......@@ -1372,95 +1382,106 @@ type LlvmConfig = (LlvmTargets, LlvmPasses)
-----------------------------------------------------------------------------
-- Accessessors from 'DynFlags'
targetPlatform :: DynFlags -> Platform
targetPlatform dflags = sTargetPlatform (settings dflags)
-- | "unbuild" a 'Settings' from a 'DynFlags'. This shouldn't be needed in the
-- vast majority of code. But GHCi questionably uses this to produce a default
-- 'DynFlags' from which to compute a flags diff for printing.
settings :: DynFlags -> Settings
settings dflags = Settings
{ sGhcNameVersion = ghcNameVersion dflags
, sFileSettings = fileSettings dflags
, sTargetPlatform = targetPlatform dflags
, sToolSettings = toolSettings dflags
, sPlatformMisc = platformMisc dflags
, sPlatformConstants = platformConstants dflags
, sRawSettings = rawSettings dflags
}
programName :: DynFlags -> String
programName dflags = sProgramName (settings dflags)
programName dflags = ghcNameVersion_programName $ ghcNameVersion dflags
projectVersion :: DynFlags -> String
projectVersion dflags = sProjectVersion (settings dflags)
projectVersion dflags = ghcNameVersion_projectVersion (ghcNameVersion dflags)
ghcUsagePath :: DynFlags -> FilePath
ghcUsagePath dflags = sGhcUsagePath (settings dflags)
ghcUsagePath dflags = fileSettings_ghcUsagePath $ fileSettings dflags
ghciUsagePath :: DynFlags -> FilePath
ghciUsagePath dflags = sGhciUsagePath (settings dflags)
ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
toolDir :: DynFlags -> Maybe FilePath
toolDir dflags = sToolDir (settings dflags)
toolDir dflags = fileSettings_toolDir $ fileSettings dflags
topDir :: DynFlags -> FilePath
topDir dflags = sTopDir (settings dflags)
topDir dflags = fileSettings_topDir $ fileSettings dflags
tmpDir :: DynFlags -> String
tmpDir dflags = sTmpDir (settings dflags)
rawSettings :: DynFlags -> [(String, String)]
rawSettings dflags = sRawSettings (settings dflags)
tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags
extraGccViaCFlags :: DynFlags -> [String]
extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)
extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
systemPackageConfig :: DynFlags -> FilePath
systemPackageConfig dflags = sSystemPackageConfig (settings dflags)
systemPackageConfig dflags = fileSettings_systemPackageConfig $ fileSettings dflags
pgm_L :: DynFlags -> String
pgm_L dflags = sPgm_L (settings dflags)
pgm_L dflags = toolSettings_pgm_L $ toolSettings dflags
pgm_P :: DynFlags -> (String,[Option])
pgm_P dflags = sPgm_P (settings dflags)
pgm_P dflags = toolSettings_pgm_P $ toolSettings dflags
pgm_F :: DynFlags -> String
pgm_F dflags = sPgm_F (settings dflags)
pgm_F dflags = toolSettings_pgm_F $ toolSettings dflags
pgm_c :: DynFlags -> (String,[Option])
pgm_c dflags = sPgm_c (settings dflags)
pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags
pgm_a :: DynFlags -> (String,[Option])
pgm_a dflags = sPgm_a (settings dflags)
pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags
pgm_l :: DynFlags -> (String,[Option])
pgm_l dflags = sPgm_l (settings dflags)
pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags
pgm_dll :: DynFlags -> (String,[Option])
pgm_dll dflags = sPgm_dll (settings dflags)
pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
pgm_T :: DynFlags -> String
pgm_T dflags = sPgm_T (settings dflags)
pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags
pgm_windres :: DynFlags -> String
pgm_windres dflags = sPgm_windres (settings dflags)
pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags
pgm_libtool :: DynFlags -> String
pgm_libtool dflags = sPgm_libtool (settings dflags)
pgm_libtool dflags = toolSettings_pgm_libtool $ toolSettings dflags
pgm_lcc :: DynFlags -> (String,[Option])
pgm_lcc dflags = sPgm_lcc (settings dflags)
pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags
pgm_ar :: DynFlags -> String
pgm_ar dflags = sPgm_ar (settings dflags)
pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags
pgm_ranlib :: DynFlags -> String
pgm_ranlib dflags = sPgm_ranlib (settings dflags)
pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags
pgm_lo :: DynFlags -> (String,[Option])
pgm_lo dflags = sPgm_lo (settings dflags)
pgm_lo dflags = toolSettings_pgm_lo $ toolSettings dflags
pgm_lc :: DynFlags -> (String,[Option])
pgm_lc dflags = sPgm_lc (settings dflags)
pgm_lc dflags = toolSettings_pgm_lc $ toolSettings dflags
pgm_i :: DynFlags -> String
pgm_i dflags = sPgm_i (settings dflags)
pgm_i dflags = toolSettings_pgm_i $ toolSettings dflags
opt_L :: DynFlags -> [String]
opt_L dflags = sOpt_L (settings dflags)
opt_L dflags = toolSettings_opt_L $ toolSettings dflags
opt_P :: DynFlags -> [String]
opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
++ sOpt_P (settings dflags)
++ toolSettings_opt_P (toolSettings dflags)
-- This function packages everything that's needed to fingerprint opt_P
-- flags. See Note [Repeated -optP hashing].
opt_P_signature :: DynFlags -> ([String], Fingerprint)
opt_P_signature dflags =
( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
, sOpt_P_fingerprint (settings dflags))
, toolSettings_opt_P_fingerprint $ toolSettings dflags
)
opt_F :: DynFlags -> [String]
opt_F dflags = sOpt_F (settings dflags)
opt_F dflags= toolSettings_opt_F $ toolSettings dflags
opt_c :: DynFlags -> [String]
opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
++ sOpt_c (settings dflags)
++ toolSettings_opt_c (toolSettings dflags)
opt_cxx :: DynFlags -> [String]
opt_cxx dflags = sOpt_cxx (settings dflags)
opt_cxx dflags= toolSettings_opt_cxx $ toolSettings dflags
opt_a :: DynFlags -> [String]
opt_a dflags = sOpt_a (settings dflags)
opt_a dflags= toolSettings_opt_a $ toolSettings dflags
opt_l :: DynFlags -> [String]
opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
++ sOpt_l (settings dflags)
++ toolSettings_opt_l (toolSettings dflags)
opt_windres :: DynFlags -> [String]
opt_windres dflags = sOpt_windres (settings dflags)
opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags
opt_lcc :: DynFlags -> [String]
opt_lcc dflags = sOpt_lcc (settings dflags)
opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags
opt_lo :: DynFlags -> [String]
opt_lo dflags = sOpt_lo (settings dflags)
opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags
opt_lc :: DynFlags -> [String]
opt_lc dflags = sOpt_lc (settings dflags)
opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
opt_i :: DynFlags -> [String]
opt_i dflags = sOpt_i (settings dflags)
opt_i dflags= toolSettings_opt_i $ toolSettings dflags
-- | The directory for this version of ghc in the user's app directory
-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
......@@ -1626,18 +1647,19 @@ instance Outputable PackageFlag where
ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
ppr (HidePackage str) = text "-hide-package" <+> text str
defaultHscTarget :: Settings -> HscTarget
defaultHscTarget = defaultObjectTarget
-- | The 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
defaultObjectTarget :: Settings -> HscTarget
defaultObjectTarget settings
| platformUnregisterised platform = HscC
| sGhcWithNativeCodeGen settings = HscAsm
| otherwise = HscLlvm
where
platform = sTargetPlatform settings
defaultHscTarget :: Platform -> PlatformMisc -> HscTarget
defaultHscTarget platform pMisc
| platformUnregisterised platform = HscC
| platformMisc_ghcWithNativeCodeGen pMisc = HscAsm
| otherwise = HscLlvm
defaultObjectTarget :: DynFlags -> HscTarget
defaultObjectTarget dflags = defaultHscTarget
(targetPlatform dflags)
(platformMisc dflags)
-- Determines whether we will be compiling
-- info tables that reside just before the entry code, or with an
......@@ -1646,7 +1668,7 @@ defaultObjectTarget settings
tablesNextToCode :: DynFlags -> Bool
tablesNextToCode dflags =
not (platformUnregisterised $ targetPlatform dflags) &&
sTablesNextToCode (settings dflags)
platformMisc_tablesNextToCode (platformMisc dflags)
data DynLibLoader
= Deployable
......@@ -1900,7 +1922,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
DynFlags {
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget mySettings,
hscTarget = defaultHscTarget (sTargetPlatform mySettings) (sPlatformMisc mySettings),
integerLibrary = sIntegerLibraryType mySettings,
verbosity = 0,
optLevel = 0,
......@@ -1997,7 +2019,15 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
ways = defaultWays mySettings,
buildTag = mkBuildTag (defaultWays mySettings),
splitInfo = Nothing,
settings = mySettings,
ghcNameVersion = sGhcNameVersion mySettings,
fileSettings = sFileSettings mySettings,
toolSettings = sToolSettings mySettings,
targetPlatform = sTargetPlatform mySettings,
platformMisc = sPlatformMisc mySettings,
platformConstants = sPlatformConstants mySettings,
rawSettings = sRawSettings mySettings,
llvmTargets = myLlvmTargets,
llvmPasses = myLlvmPasses,
......@@ -3708,8 +3738,10 @@ dynamic_flags_deps = [
, make_ord_flag defFlag "fno-code" (NoArg ((upd $ \d ->
d { ghcLink=NoLink }) >> setTarget HscNothing))
, make_ord_flag defFlag "fbyte-code" (NoArg (setTarget HscInterpreted))
, make_ord_flag defFlag "fobject-code" (NoArg (setTargetWithSettings
defaultHscTarget))
, make_ord_flag defFlag "fobject-code" $ NoArg $ do
dflags <- liftEwM getCmdLineState
setTarget $ defaultObjectTarget dflags
, make_dep_flag defFlag "fglasgow-exts"
(NoArg enableGlasgowExts) "Use individual extensions instead"
, make_dep_flag defFlag "fno-glasgow-exts"
......@@ -5083,14 +5115,11 @@ unSetExtensionFlag' f dflags = xopt_unset dflags f
-- (except for -fno-glasgow-exts, which is treated specially)
--------------------------
alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
alterSettings f dflags = dflags { settings = f (settings dflags) }
alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags
alterFileSettings = alterSettings . \f settings -> settings { sFileSettings = f (sFileSettings settings) }
alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) }
alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
alterToolSettings = alterSettings . \f settings -> settings { sToolSettings = f (sToolSettings settings) }
alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) }
--------------------------
setDumpFlag' :: DumpFlag -> DynP ()
......@@ -5397,15 +5426,10 @@ interpretPackageEnv dflags = do
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
setTarget :: HscTarget -> DynP ()
setTarget l = setTargetWithSettings (const l)
setTargetWithSettings :: (Settings -> HscTarget) -> DynP ()
setTargetWithSettings f = upd set
where
set dfs = let l = f (settings dfs)
in if ghcLink dfs /= LinkBinary || isObjectTarget l
then dfs{ hscTarget = l }
else dfs
setTarget l = upd $ \ dfs ->
if ghcLink dfs /= LinkBinary || isObjectTarget l
then dfs{ hscTarget = l }
else dfs
-- Changes the target only if we're compiling object code. This is
-- used by -fasm and -fllvm, which switch from one to the other, but
......@@ -5594,7 +5618,7 @@ picCCOpts dflags = pieOpts ++ picOpts
pieOpts
| gopt Opt_PICExecutable dflags = ["-pie"]
-- See Note [No PIE when linking]
| sGccSupportsNoPie (settings dflags) = ["-no-pie"]
| toolSettings_ccSupportsNoPie (toolSettings dflags) = ["-no-pie"]
| otherwise = []
......@@ -5633,14 +5657,14 @@ compilerInfo dflags
("Stage", cStage),
("Build platform", cBuildPlatformString),
("Host platform", cHostPlatformString),
("Target platform", sTargetPlatformString $ settings dflags),
("Have interpreter", showBool $ sGhcWithInterpreter $ settings dflags),
("Target platform", platformMisc_targetPlatformString $ platformMisc dflags),
("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
("Object splitting supported", showBool False),
("Have native code generator", showBool $ sGhcWithNativeCodeGen $ settings dflags),
("Support SMP", showBool $ sGhcWithSMP $ settings dflags),
("Tables next to code", showBool $ sTablesNextToCode $ settings dflags),
("RTS ways", sGhcRTSWays $ settings dflags),
("RTS expects libdw", showBool $ sGhcRtsWithLibdw $ settings dflags),
("Have native code generator", showBool $ platformMisc_ghcWithNativeCodeGen $ platformMisc dflags),
("Support SMP", showBool $ platformMisc_ghcWithSMP $ platformMisc dflags),
("Tables next to code", showBool $ platformMisc_tablesNextToCode $ platformMisc dflags),
("RTS ways", platformMisc_ghcRTSWays $ platformMisc dflags),
("RTS expects libdw", showBool $ platformMisc_ghcRtsWithLibdw $ platformMisc dflags),
-- Whether or not we support @-dynamic-too@
("Support dynamic-too", showBool $ not isWindows),
-- Whether or not we support the @-j@ flag with @--make@.
......@@ -5667,7 +5691,7 @@ compilerInfo dflags
("GHC Dynamic", showBool dynamicGhc),
-- Whether or not GHC was compiled using -prof
("GHC Profiled", showBool rtsIsProfiled),
("Leading underscore", showBool $ sLeadingUnderscore $ settings dflags),
("Leading underscore", showBool $ platformMisc_leadingUnderscore $ platformMisc dflags),
("Debug on", show debugIsOn),
("LibDir", topDir dflags),
-- The path of the global package database used by GHC
......@@ -5758,7 +5782,7 @@ makeDynFlagsConsistent dflags
in loop dflags' warn
| hscTarget dflags == HscC &&
not (platformUnregisterised (targetPlatform dflags))
= if sGhcWithNativeCodeGen $ settings dflags
= if platformMisc_ghcWithNativeCodeGen $ platformMisc dflags
then let dflags' = dflags { hscTarget = HscAsm }
warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"
in loop dflags' warn
......@@ -5774,7 +5798,7 @@ makeDynFlagsConsistent dflags
= loop (dflags { hscTarget = HscC })
"Compiler unregisterised, so compiling via C"
| hscTarget dflags == HscAsm &&
not (sGhcWithNativeCodeGen $ settings dflags)
not (platformMisc_ghcWithNativeCodeGen $ platformMisc dflags)
= let dflags' = dflags { hscTarget = HscLlvm }
warn = "No native code generator, so using LLVM"
in loop dflags' warn
......
......@@ -1958,11 +1958,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
-- See Note [-fno-code mode] #8025
map1 <- if hscTarget dflags == HscNothing
then enableCodeGenForTH
(defaultObjectTarget (settings dflags))
(defaultObjectTarget dflags)
map0
else if hscTarget dflags == HscInterpreted
then enableCodeGenForUnboxedTuples
(defaultObjectTarget (settings dflags))
(defaultObjectTarget dflags)
map0
else return map0
return $ concat $ nodeMapElts map1
......
......@@ -433,10 +433,10 @@ linkDynLib dflags0 o_files dep_packages
-- against libHSrts, then both end up getting loaded,
-- and things go wrong. We therefore link the libraries
-- with the same RTS flags that we link GHC with.
dflags1 = if sGhcThreaded $ settings dflags0
dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0
then addWay' WayThreaded dflags0
else dflags0
dflags2 = if sGhcDebugged $ settings dflags1
dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1
then addWay' WayDebug dflags1
else dflags1
dflags = updateWays dflags2
......
......@@ -7,7 +7,6 @@ module GHCi.Leak
import Control.Monad
import Data.Bits
import DynFlags ( sTargetPlatform )
import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
import GHC
import GHC.Ptr (Ptr (..))
......@@ -68,7 +67,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do
show (maskTagBits addr))
tagBits
| target32Bit (sTargetPlatform (settings dflags)) = 2
| target32Bit (targetPlatform dflags) = 2
| otherwise = 3
maskTagBits :: Ptr a -> Ptr a
......
......@@ -34,7 +34,7 @@
* configuration from 'targetPlatform :: DynFlags -> Platform'
* record. A few wrappers are already defined and used throughout GHC:
* wORD_SIZE :: DynFlags -> Int
* wORD_SIZE dflags = pc_WORD_SIZE (sPlatformConstants (settings dflags))
* wORD_SIZE dflags = pc_WORD_SIZE (platformConstants dflags)