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
......
This diff is collapsed.
......@@ -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)
*
* Hence we hide these macros from -DSTAGE=1
*/
......
......@@ -918,13 +918,13 @@ writeHaskellWrappers fn ws = writeFile fn xs
doWhat (GetFieldType {}) = []
doWhat (GetClosureSize {}) = []
doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int",
haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"]
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
doWhat (GetInt name _) = [haskellise name ++ " :: DynFlags -> Int",
haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"]
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
doWhat (GetNatural name _) = [haskellise name ++ " :: DynFlags -> Integer",
haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"]
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
doWhat (GetBool name _) = [haskellise name ++ " :: DynFlags -> Bool",
haskellise name ++ " dflags = pc_" ++ name ++ " (sPlatformConstants (settings dflags))"]
haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
doWhat (StructFieldMacro {}) = []
doWhat (ClosureFieldMacro {}) = []
doWhat (ClosurePayloadMacro {}) = []
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment