diff options
| -rw-r--r-- | compiler/cmm/CLabel.hs | 14 | ||||
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 2 | ||||
| -rw-r--r-- | compiler/cmm/CmmType.hs | 8 | ||||
| -rw-r--r-- | compiler/deSugar/DsForeign.hs | 2 | ||||
| -rw-r--r-- | compiler/ghci/Linker.hs | 2 | ||||
| -rw-r--r-- | compiler/main/CodeOutput.hs | 4 | ||||
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 21 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 194 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 4 | ||||
| -rw-r--r-- | compiler/main/SysTools.hs | 4 | ||||
| -rw-r--r-- | ghc/GHCi/Leak.hs | 3 | ||||
| -rw-r--r-- | includes/MachDeps.h | 2 | ||||
| -rw-r--r-- | utils/deriveConstants/Main.hs | 8 |
13 files changed, 146 insertions, 122 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index fddb063185..d30bd4c0f7 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -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 diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 345f3facaa..c374e9fd81 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -531,7 +531,7 @@ funInfoArity dflags iptr | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc , oFFSET_StgFunInfoExtraFwd_arity dflags ) - pc = sPlatformConstants (settings dflags) + pc = platformConstants dflags ----------------------------------------------------------------------------- -- diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs index 276fbff534..43d23c7ee7 100644 --- a/compiler/cmm/CmmType.hs +++ b/compiler/cmm/CmmType.hs @@ -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] diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 4df053d845..dd0cc4860a 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -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: diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 636e7c35de..077b067c3c 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -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 ] diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index 1ded72111a..050e6f5c14 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -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 diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 1822abb549..c8a1a9f704 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -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 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 1f0fb2f7ef..91bf627aaa 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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 diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 3e62558e78..c53532a5a8 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -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 diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 763477a1c9..2899ba383d 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -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 diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index 874d9e2cdc..3bb9bbceb5 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -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 diff --git a/includes/MachDeps.h b/includes/MachDeps.h index 22aec83840..fd13e3315a 100644 --- a/includes/MachDeps.h +++ b/includes/MachDeps.h @@ -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 */ diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index 2c7a8379b9..a812ac42c8 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -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 {}) = [] |