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) ...@@ -1162,7 +1162,7 @@ pprCLabel dynFlags (AsmTempLabel u)
= tempLabelPrefixOrUnderscore <> pprUniqueAlways u = tempLabelPrefixOrUnderscore <> pprUniqueAlways u
pprCLabel dynFlags (AsmTempDerivedLabel l suf) pprCLabel dynFlags (AsmTempDerivedLabel l suf)
| sGhcWithNativeCodeGen $ settings dynFlags | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= ptext (asmTempLabelPrefix $ targetPlatform dynFlags) = ptext (asmTempLabelPrefix $ targetPlatform dynFlags)
<> case l of AsmTempLabel u -> pprUniqueAlways u <> case l of AsmTempLabel u -> pprUniqueAlways u
LocalBlockLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u
...@@ -1170,15 +1170,15 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf) ...@@ -1170,15 +1170,15 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf)
<> ftext suf <> ftext suf
pprCLabel dynFlags (DynamicLinkerLabel info lbl) pprCLabel dynFlags (DynamicLinkerLabel info lbl)
| sGhcWithNativeCodeGen $ settings dynFlags | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl
pprCLabel dynFlags PicBaseLabel pprCLabel dynFlags PicBaseLabel
| sGhcWithNativeCodeGen $ settings dynFlags | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= text "1b" = text "1b"
pprCLabel dynFlags (DeadStripPreventer lbl) 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 `lbl` can be temp one but we need to ensure that dsp label will stay
...@@ -1190,18 +1190,18 @@ pprCLabel dynFlags (DeadStripPreventer lbl) ...@@ -1190,18 +1190,18 @@ pprCLabel dynFlags (DeadStripPreventer lbl)
<> pprCLabel dynFlags lbl <> text "_dsp" <> pprCLabel dynFlags lbl <> text "_dsp"
pprCLabel dynFlags (StringLitLabel u) pprCLabel dynFlags (StringLitLabel u)
| sGhcWithNativeCodeGen $ settings dynFlags | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags
= pprUniqueAlways u <> ptext (sLit "_str") = pprUniqueAlways u <> ptext (sLit "_str")
pprCLabel dynFlags lbl pprCLabel dynFlags lbl
= getPprStyle $ \ sty -> = getPprStyle $ \ sty ->
if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty if platformMisc_ghcWithNativeCodeGen (platformMisc dynFlags) && asmStyle sty
then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl
else pprCLbl lbl else pprCLbl lbl
maybe_underscore :: DynFlags -> SDoc -> SDoc maybe_underscore :: DynFlags -> SDoc -> SDoc
maybe_underscore dynFlags doc = maybe_underscore dynFlags doc =
if sLeadingUnderscore $ settings dynFlags if platformMisc_leadingUnderscore $ platformMisc dynFlags
then pp_cSEP <> doc then pp_cSEP <> doc
else doc else doc
......
...@@ -531,7 +531,7 @@ funInfoArity dflags iptr ...@@ -531,7 +531,7 @@ funInfoArity dflags iptr
| otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
, oFFSET_StgFunInfoExtraFwd_arity dflags ) , oFFSET_StgFunInfoExtraFwd_arity dflags )
pc = sPlatformConstants (settings dflags) pc = platformConstants dflags
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- --
......
...@@ -335,22 +335,22 @@ data ForeignHint ...@@ -335,22 +335,22 @@ data ForeignHint
rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
rEP_CostCentreStack_mem_alloc dflags rEP_CostCentreStack_mem_alloc dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc)) = 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 :: DynFlags -> CmmType
rEP_CostCentreStack_scc_count dflags rEP_CostCentreStack_scc_count dflags
= cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc)) = 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 :: DynFlags -> CmmType
rEP_StgEntCounter_allocs dflags rEP_StgEntCounter_allocs dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc)) = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
where pc = sPlatformConstants (settings dflags) where pc = platformConstants dflags
rEP_StgEntCounter_allocd :: DynFlags -> CmmType rEP_StgEntCounter_allocd :: DynFlags -> CmmType
rEP_StgEntCounter_allocd dflags rEP_StgEntCounter_allocd dflags
= cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc)) = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
where pc = sPlatformConstants (settings dflags) where pc = platformConstants dflags
------------------------------------------------------------------------- -------------------------------------------------------------------------
{- Note [Signed vs unsigned] {- Note [Signed vs unsigned]
......
...@@ -541,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ...@@ -541,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
| otherwise = text ('a':show n) | otherwise = text ('a':show n)
-- generate a libffi-style stub if this is a "wrapper" and libffi is enabled -- 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 type_string
-- libffi needs to know the result type too: -- libffi needs to know the result type too:
......
...@@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls = ...@@ -343,7 +343,7 @@ linkCmdLineLibs' hsc_env pls =
-- Add directories to library search paths, this only has an effect -- Add directories to library search paths, this only has an effect
-- on Windows. On Unix OSes this function is a NOP. -- 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 : framework_paths
++ lib_paths_base ++ lib_paths_base
++ [ takeDirectory dll | DLLPath dll <- libspecs ] ++ [ takeDirectory dll | DLLPath dll <- libspecs ]
......
...@@ -155,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath ...@@ -155,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath
-> Stream IO RawCmmGroup () -> Stream IO RawCmmGroup ()
-> IO () -> IO ()
outputAsm dflags this_mod location filenm cmm_stream outputAsm dflags this_mod location filenm cmm_stream
| sGhcWithNativeCodeGen $ settings dflags | platformMisc_ghcWithNativeCodeGen $ platformMisc dflags
= do ncg_uniqs <- mkSplitUniqSupply 'n' = do ncg_uniqs <- mkSplitUniqSupply 'n'
debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm) debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
...@@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs ...@@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs
-- wrapper code mentions the ffi_arg type, which comes from ffi.h -- wrapper code mentions the ffi_arg type, which comes from ffi.h
ffi_includes ffi_includes
| sLibFFI $ settings dflags = "#include \"ffi.h\"\n" | platformMisc_libFFI $ platformMisc dflags = "#include \"ffi.h\"\n"
| otherwise = "" | otherwise = ""
stub_h_file_exists stub_h_file_exists
......
...@@ -59,6 +59,7 @@ import LlvmCodeGen ( llvmFixupAsm ) ...@@ -59,6 +59,7 @@ import LlvmCodeGen ( llvmFixupAsm )
import MonadUtils import MonadUtils
import Platform import Platform
import TcRnTypes import TcRnTypes
import ToolSettings
import Hooks import Hooks
import qualified GHC.LanguageExtensions as LangExt import qualified GHC.LanguageExtensions as LangExt
import FileCleanup import FileCleanup
...@@ -373,7 +374,7 @@ link ghcLink dflags ...@@ -373,7 +374,7 @@ link ghcLink dflags
= lookupHook linkHook l dflags ghcLink dflags = lookupHook linkHook l dflags ghcLink dflags
where where
l LinkInMemory _ _ _ l LinkInMemory _ _ _
= if sGhcWithInterpreter $ settings dflags = if platformMisc_ghcWithInterpreter $ platformMisc dflags
then -- Not Linking...(demand linker will do the job) then -- Not Linking...(demand linker will do the job)
return Succeeded return Succeeded
else panicBadLink LinkInMemory else panicBadLink LinkInMemory
...@@ -1605,7 +1606,7 @@ linkBinary = linkBinary' False ...@@ -1605,7 +1606,7 @@ linkBinary = linkBinary' False
linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO () linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
linkBinary' staticLink dflags o_files dep_packages = do linkBinary' staticLink dflags o_files dep_packages = do
let platform = targetPlatform dflags let platform = targetPlatform dflags
mySettings = settings dflags toolSettings' = toolSettings dflags
verbFlags = getVerbFlags dflags verbFlags = getVerbFlags dflags
output_fn = exeFileName staticLink dflags output_fn = exeFileName staticLink dflags
...@@ -1761,7 +1762,7 @@ linkBinary' staticLink dflags o_files dep_packages = do ...@@ -1761,7 +1762,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
-- like -- like
-- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog -- ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
-- on x86. -- on x86.
++ (if sLdSupportsCompactUnwind mySettings && ++ (if toolSettings_ldSupportsCompactUnwind toolSettings' &&
not staticLink && not staticLink &&
(platformOS platform == OSDarwin) && (platformOS platform == OSDarwin) &&
case platformArch platform of case platformArch platform of
...@@ -1785,7 +1786,7 @@ linkBinary' staticLink dflags o_files dep_packages = do ...@@ -1785,7 +1786,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
then ["-Wl,-read_only_relocs,suppress"] then ["-Wl,-read_only_relocs,suppress"]
else []) else [])
++ (if sLdIsGnuLd mySettings && ++ (if toolSettings_ldIsGnuLd toolSettings' &&
not (gopt Opt_WholeArchiveHsLibs dflags) not (gopt Opt_WholeArchiveHsLibs dflags)
then ["-Wl,--gc-sections"] then ["-Wl,--gc-sections"]
else []) else [])
...@@ -1912,7 +1913,7 @@ linkStaticLib dflags o_files dep_packages = do ...@@ -1912,7 +1913,7 @@ linkStaticLib dflags o_files dep_packages = do
<$> (Archive <$> mapM loadObj modules) <$> (Archive <$> mapM loadObj modules)
<*> mapM loadAr archives <*> mapM loadAr archives
if sLdIsGnuLd (settings dflags) if toolSettings_ldIsGnuLd (toolSettings dflags)
then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar
...@@ -2085,15 +2086,15 @@ none of this can be used in that case. ...@@ -2085,15 +2086,15 @@ none of this can be used in that case.
joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO () joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()
joinObjectFiles dflags o_files output_fn = do joinObjectFiles dflags o_files output_fn = do
let mySettings = settings dflags let toolSettings' = toolSettings dflags
ldIsGnuLd = sLdIsGnuLd mySettings ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
osInfo = platformOS (targetPlatform dflags) osInfo = platformOS (targetPlatform dflags)
ld_r args cc = SysTools.runLink dflags ([ ld_r args cc = SysTools.runLink dflags ([
SysTools.Option "-nostdlib", SysTools.Option "-nostdlib",
SysTools.Option "-Wl,-r" SysTools.Option "-Wl,-r"
] ]
-- See Note [No PIE while linking] in DynFlags -- See Note [No PIE while linking] in DynFlags
++ (if sGccSupportsNoPie mySettings ++ (if toolSettings_ccSupportsNoPie toolSettings'
then [SysTools.Option "-no-pie"] then [SysTools.Option "-no-pie"]
else []) else [])
...@@ -2124,7 +2125,7 @@ joinObjectFiles dflags o_files output_fn = do ...@@ -2124,7 +2125,7 @@ joinObjectFiles dflags o_files output_fn = do
-- suppress the generation of the .note.gnu.build-id section, -- suppress the generation of the .note.gnu.build-id section,
-- which we don't need and sometimes causes ld to emit a -- which we don't need and sometimes causes ld to emit a
-- warning: -- warning:
ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"] ld_build_id | toolSettings_ldSupportsBuildId toolSettings' = ["-Wl,--build-id=none"]
| otherwise = [] | otherwise = []
ccInfo <- getCompilerInfo dflags ccInfo <- getCompilerInfo dflags
...@@ -2135,7 +2136,7 @@ joinObjectFiles dflags o_files output_fn = do ...@@ -2135,7 +2136,7 @@ joinObjectFiles dflags o_files output_fn = do
let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files let o_files_abs = map (\x -> "\"" ++ (cwd </> x) ++ "\"") o_files
writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
ld_r [SysTools.FileOption "" script] ccInfo ld_r [SysTools.FileOption "" script] ccInfo
else if sLdSupportsFilelist mySettings else if toolSettings_ldSupportsFilelist toolSettings'
then do then do
filelist <- newTempName dflags TFL_CurrentModule "filelist" filelist <- newTempName dflags TFL_CurrentModule "filelist"
writeFile filelist $ unlines o_files writeFile filelist $ unlines o_files
......
This diff is collapsed.
...@@ -1958,11 +1958,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots ...@@ -1958,11 +1958,11 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
-- See Note [-fno-code mode] #8025 -- See Note [-fno-code mode] #8025
map1 <- if hscTarget dflags == HscNothing map1 <- if hscTarget dflags == HscNothing
then enableCodeGenForTH then enableCodeGenForTH
(defaultObjectTarget (settings dflags)) (defaultObjectTarget dflags)
map0 map0
else if hscTarget dflags == HscInterpreted else if hscTarget dflags == HscInterpreted
then enableCodeGenForUnboxedTuples then enableCodeGenForUnboxedTuples
(defaultObjectTarget (settings dflags)) (defaultObjectTarget dflags)
map0 map0
else return map0 else return map0
return $ concat $ nodeMapElts map1 return $ concat $ nodeMapElts map1
......
...@@ -433,10 +433,10 @@ linkDynLib dflags0 o_files dep_packages ...@@ -433,10 +433,10 @@ linkDynLib dflags0 o_files dep_packages
-- against libHSrts, then both end up getting loaded, -- against libHSrts, then both end up getting loaded,
-- and things go wrong. We therefore link the libraries -- and things go wrong. We therefore link the libraries
-- with the same RTS flags that we link GHC with. -- 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 then addWay' WayThreaded dflags0
else dflags0 else dflags0
dflags2 = if sGhcDebugged $ settings dflags1 dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1
then addWay' WayDebug dflags1 then addWay' WayDebug dflags1
else dflags1 else dflags1
dflags = updateWays dflags2 dflags = updateWays dflags2
......
...@@ -7,7 +7,6 @@ module GHCi.Leak ...@@ -7,7 +7,6 @@ module GHCi.Leak
import Control.Monad import Control.Monad
import Data.Bits import Data.Bits
import DynFlags ( sTargetPlatform )
import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
import GHC import GHC
import GHC.Ptr (Ptr (..)) import GHC.Ptr (Ptr (..))
...@@ -68,7 +67,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do ...@@ -68,7 +67,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do
show (maskTagBits addr)) show (maskTagBits addr))
tagBits tagBits
| target32Bit (sTargetPlatform (settings dflags)) = 2 | target32Bit (targetPlatform dflags) = 2
| otherwise = 3 | otherwise = 3
maskTagBits :: Ptr a -> Ptr a maskTagBits :: Ptr a -> Ptr a
......
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
* configuration from 'targetPlatform :: DynFlags -> Platform' * configuration from 'targetPlatform :: DynFlags -> Platform'
* record. A few wrappers are already defined and used throughout GHC: * record. A few wrappers are already defined and used throughout GHC:
* wORD_SIZE :: DynFlags -> Int * 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 * Hence we hide these macros from -DSTAGE=1
*/ */
......
...@@ -918,13 +918,13 @@ writeHaskellWrappers fn ws = writeFile fn xs ...@@ -918,13 +918,13 @@ writeHaskellWrappers fn ws = writeFile fn xs
doWhat (GetFieldType {}) = [] doWhat (GetFieldType {}) = []
doWhat (GetClosureSize {}) = [] doWhat (GetClosureSize {}) = []
doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int", 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", 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", 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", 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 (StructFieldMacro {}) = []
doWhat (ClosureFieldMacro {}) = [] doWhat (ClosureFieldMacro {}) = []
doWhat (ClosurePayloadMacro {}) = [] 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