[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Break up `Settings` into smaller structs
Marge Bot
gitlab at gitlab.haskell.org
Wed May 29 20:38:24 UTC 2019
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ace2e335 by John Ericson at 2019-05-29T20:06:45Z
Break up `Settings` into smaller structs
As far as I can tell, the fields within `Settings` aren't *intrinsicly*
related. They just happen to be initialized the same way (in particular
prior to the rest of `DynFlags`), and that is why they are grouped
together.
Within `Settings`, however, there are groups of settings that clearly do
share something in common, regardless of how they anything is
initialized.
In the spirit of GHC being a library, where the end cosumer may choose
to initialize this configuration in arbitrary ways, I made some new data
types for thoses groups internal to `Settings`, and used them to define
`Settings` instead. Hopefully this is a baby step towards a general
decoupling of the stateful and stateless parts of GHC.
- - - - -
bfccd832 by John Ericson at 2019-05-29T20:06:45Z
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.
- - - - -
a1bf3413 by David Eichmann at 2019-05-29T20:07:24Z
Hadrian: Add note about Libffi's Indicating Inputs #16653
[skip ci]
- - - - -
382dc918 by Alp Mestanogullari at 2019-05-29T20:38:12Z
Hadrian: always generate the libffi dynlibs manifest with globbing
Instead of trying to deduce which dynlibs are expected to be found (and then
copied to the RTS's build dir) in libffi's build directory, with some OS
specific logic, we now always just use `getDirectoryFilesIO` to look for
those dynlibs and record their names in the manifest. The previous logic
ended up causing problems on Windows, where we don't build dynlibs at all
for now but the manifest file's logic didn't take that into account because
it was only partially reproducing the criterions that determine whether or not
we will be building shared libraries.
This patch also re-enables the Hadrian/Windows CI job, which was failing to
build GHC precisely because of libffi shared libraries and the aforementionned
duplicated logic.
- - - - -
76ac01dc by Ben Gamari at 2019-05-29T20:38:13Z
CODEOWNERS: Use correct username for Richard Eisenberg
In !980 Richard noted that he could not approve the MR.
This mis-spelling was the reason.
[skip ci]
- - - - -
c511fd4e by Ben Gamari at 2019-05-29T20:38:13Z
rts: Handle zero-sized mappings in MachO linker
As noted in #16701, it is possible that we will find that an object has
no segments needing to be mapped. Previously this would result in mmap
being called for a zero-length mapping, which would fail. We now simply
skip the mmap call in this case; the rest of the logic just works.
- - - - -
24 changed files:
- .gitlab-ci.yml
- CODEOWNERS
- compiler/cmm/CLabel.hs
- compiler/cmm/CmmInfo.hs
- compiler/cmm/CmmType.hs
- compiler/deSugar/DsForeign.hs
- compiler/ghc.cabal.in
- compiler/ghci/Linker.hs
- + compiler/main/CliOption.hs
- compiler/main/CodeOutput.hs
- compiler/main/DriverPipeline.hs
- compiler/main/DynFlags.hs
- + compiler/main/FileSettings.hs
- compiler/main/GhcMake.hs
- + compiler/main/GhcNameVersion.hs
- + compiler/main/Settings.hs
- compiler/main/SysTools.hs
- + compiler/main/ToolSettings.hs
- compiler/utils/Platform.hs
- ghc/GHCi/Leak.hs
- hadrian/src/Rules/Libffi.hs
- includes/MachDeps.h
- rts/linker/MachO.c
- utils/deriveConstants/Main.hs
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -577,7 +577,7 @@ validate-x86_64-linux-fedora27:
paths:
- ghc.tar.xz
-.validate-x86_64-windows-hadrian:
+validate-x86_64-windows-hadrian:
extends: .build-windows-hadrian
variables:
MSYSTEM: MINGW64
=====================================
CODEOWNERS
=====================================
@@ -17,10 +17,10 @@
# The compiler
/compiler/parser/ @int-index
-/compiler/typecheck/ @simonpj @goldfire
-/compiler/rename/ @simonpj @goldfire
-/compiler/types/ @simonpj @goldfire
-/compiler/deSugar/ @simonpj @goldfire
+/compiler/typecheck/ @simonpj @rae
+/compiler/rename/ @simonpj @rae
+/compiler/types/ @simonpj @rae
+/compiler/deSugar/ @simonpj @rae
/compiler/typecheck/TcDeriv* @RyanGlScott
/compiler/nativeGen/ @simonmar @bgamari @AndreasK
/compiler/llvmGen/ @angerman
@@ -34,12 +34,12 @@
/compiler/simplStg/StgLiftLams.hs @sgraf
/compiler/cmm/CmmSwitch.hs @nomeata
/compiler/stranal/DmdAnal.hs @simonpj @sgraf
-/compiler/hsSyn/Convert.hs @goldfire
+/compiler/hsSyn/Convert.hs @rae
# Core libraries
/libraries/base/ @hvr
/libraries/ghci/ @simonmar
-/libraries/template-haskell/ @goldfire
+/libraries/template-haskell/ @rae
# Internal utilities and libraries
/libraries/libiserv/ @angerman @simonmar
=====================================
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
=====================================
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
-----------------------------------------------------------------------------
--
=====================================
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]
=====================================
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:
=====================================
compiler/ghc.cabal.in
=====================================
@@ -272,7 +272,10 @@ Library
CmmType
CmmUtils
CmmLayoutStack
+ CliOption
EnumSet
+ GhcNameVersion
+ FileSettings
MkGraph
PprBase
PprC
@@ -395,6 +398,7 @@ Library
Plugins
TcPluginM
PprTyThing
+ Settings
StaticPtrTable
SysTools
SysTools.BaseDir
@@ -418,6 +422,7 @@ Library
PrelNames
PrelRules
PrimOp
+ ToolSettings
TysPrim
TysWiredIn
CostCentre
=====================================
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 ]
=====================================
compiler/main/CliOption.hs
=====================================
@@ -0,0 +1,27 @@
+module CliOption
+ ( Option (..)
+ , showOpt
+ ) where
+
+import GhcPrelude
+
+-- -----------------------------------------------------------------------------
+-- Command-line options
+
+-- | When invoking external tools as part of the compilation pipeline, we
+-- pass these a sequence of options on the command-line. Rather than
+-- just using a list of Strings, we use a type that allows us to distinguish
+-- between filepaths and 'other stuff'. The reason for this is that
+-- this type gives us a handle on transforming filenames, and filenames only,
+-- to whatever format they're expected to be on a particular platform.
+data Option
+ = FileOption -- an entry that _contains_ filename(s) / filepaths.
+ String -- a non-filepath prefix that shouldn't be
+ -- transformed (e.g., "/out=")
+ String -- the filepath/filename portion
+ | Option String
+ deriving ( Eq )
+
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s) = s
=====================================
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
=====================================
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
=====================================
compiler/main/DynFlags.hs
=====================================
@@ -87,9 +87,69 @@ module DynFlags (
-- ** System tool settings and locations
Settings(..),
+ sProgramName,
+ sProjectVersion,
+ sGhcUsagePath,
+ sGhciUsagePath,
+ sToolDir,
+ sTopDir,
+ sTmpDir,
+ sSystemPackageConfig,
+ sLdSupportsCompactUnwind,
+ sLdSupportsBuildId,
+ sLdSupportsFilelist,
+ sLdIsGnuLd,
+ sGccSupportsNoPie,
+ sPgm_L,
+ sPgm_P,
+ sPgm_F,
+ sPgm_c,
+ sPgm_a,
+ sPgm_l,
+ sPgm_dll,
+ sPgm_T,
+ sPgm_windres,
+ sPgm_libtool,
+ sPgm_ar,
+ sPgm_ranlib,
+ sPgm_lo,
+ sPgm_lc,
+ sPgm_lcc,
+ sPgm_i,
+ sOpt_L,
+ sOpt_P,
+ sOpt_P_fingerprint,
+ sOpt_F,
+ sOpt_c,
+ sOpt_cxx,
+ sOpt_a,
+ sOpt_l,
+ sOpt_windres,
+ sOpt_lo,
+ sOpt_lc,
+ sOpt_lcc,
+ sOpt_i,
+ sExtraGccViaCFlags,
+ sTargetPlatformString,
+ sIntegerLibrary,
+ sIntegerLibraryType,
+ sGhcWithInterpreter,
+ sGhcWithNativeCodeGen,
+ sGhcWithSMP,
+ sGhcRTSWays,
+ sTablesNextToCode,
+ sLeadingUnderscore,
+ sLibFFI,
+ sGhcThreaded,
+ sGhcDebugged,
+ sGhcRtsWithLibdw,
IntegerLibrary(..),
- targetPlatform, programName, projectVersion,
- ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
+ GhcNameVersion(..),
+ FileSettings(..),
+ PlatformMisc(..),
+ 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,
@@ -198,9 +258,11 @@ import {-# SOURCE #-} PrelNames ( mAIN )
import {-# SOURCE #-} Packages (PackageState, emptyPackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
+import CliOption
import CmdLineParser hiding (WarnReason(..))
import qualified CmdLineParser as Cmd
import Constants
+import GhcNameVersion
import Panic
import qualified PprColour as Col
import Util
@@ -211,7 +273,11 @@ import SrcLoc
import BasicTypes ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
import FastString
import Fingerprint
+import FileSettings
import Outputable
+import Settings
+import ToolSettings
+
import Foreign.C ( CInt(..) )
import System.IO.Unsafe ( unsafeDupablePerformIO )
import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn
@@ -878,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
@@ -1304,170 +1379,109 @@ type LlvmTargets = [(String, LlvmTarget)]
type LlvmPasses = [(Int, String)]
type LlvmConfig = (LlvmTargets, LlvmPasses)
-data IntegerLibrary
- = IntegerGMP
- | IntegerSimple
- deriving (Read, Show, Eq)
-
-data Settings = Settings {
- sTargetPlatform :: Platform, -- Filled in by SysTools
- sGhcUsagePath :: FilePath, -- ditto
- sGhciUsagePath :: FilePath, -- ditto
- sToolDir :: Maybe FilePath, -- ditto
- sTopDir :: FilePath, -- ditto
- sTmpDir :: String, -- no trailing '/'
- sProgramName :: String,
- sProjectVersion :: String,
- -- You shouldn't need to look things up in rawSettings directly.
- -- They should have their own fields instead.
- sRawSettings :: [(String, String)],
- sExtraGccViaCFlags :: [String],
- sSystemPackageConfig :: FilePath,
- sLdSupportsCompactUnwind :: Bool,
- sLdSupportsBuildId :: Bool,
- sLdSupportsFilelist :: Bool,
- sLdIsGnuLd :: Bool,
- sGccSupportsNoPie :: Bool,
- -- commands for particular phases
- sPgm_L :: String,
- sPgm_P :: (String,[Option]),
- sPgm_F :: String,
- sPgm_c :: (String,[Option]),
- sPgm_a :: (String,[Option]),
- sPgm_l :: (String,[Option]),
- sPgm_dll :: (String,[Option]),
- sPgm_T :: String,
- sPgm_windres :: String,
- sPgm_libtool :: String,
- sPgm_ar :: String,
- sPgm_ranlib :: String,
- sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser
- sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler
- sPgm_lcc :: (String,[Option]), -- LLVM: c compiler
- sPgm_i :: String,
- -- options for particular phases
- sOpt_L :: [String],
- sOpt_P :: [String],
- sOpt_P_fingerprint :: Fingerprint, -- cached Fingerprint of sOpt_P
- -- See Note [Repeated -optP hashing]
- sOpt_F :: [String],
- sOpt_c :: [String],
- sOpt_cxx :: [String],
- sOpt_a :: [String],
- sOpt_l :: [String],
- sOpt_windres :: [String],
- sOpt_lo :: [String], -- LLVM: llvm optimiser
- sOpt_lc :: [String], -- LLVM: llc static compiler
- sOpt_lcc :: [String], -- LLVM: c compiler
- sOpt_i :: [String], -- iserv options
-
- sPlatformConstants :: PlatformConstants,
-
- -- Formerly Config.hs, target specific
- sTargetPlatformString :: String, -- TODO Recalculate string from richer info?
- sIntegerLibrary :: String,
- sIntegerLibraryType :: IntegerLibrary,
- sGhcWithInterpreter :: Bool,
- sGhcWithNativeCodeGen :: Bool,
- sGhcWithSMP :: Bool,
- sGhcRTSWays :: String,
- sTablesNextToCode :: Bool,
- sLeadingUnderscore :: Bool,
- sLibFFI :: Bool,
- sGhcThreaded :: Bool,
- sGhcDebugged :: Bool,
- sGhcRtsWithLibdw :: Bool
- }
-
-targetPlatform :: DynFlags -> Platform
-targetPlatform dflags = sTargetPlatform (settings dflags)
+-----------------------------------------------------------------------------
+-- Accessessors from 'DynFlags'
+
+-- | "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@)
@@ -1633,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
@@ -1653,7 +1668,7 @@ defaultObjectTarget settings
tablesNextToCode :: DynFlags -> Bool
tablesNextToCode dflags =
not (platformUnregisterised $ targetPlatform dflags) &&
- sTablesNextToCode (settings dflags)
+ platformMisc_tablesNextToCode (platformMisc dflags)
data DynLibLoader
= Deployable
@@ -1907,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,
@@ -2004,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,
@@ -2671,14 +2694,16 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option.
-setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
-addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
-addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
-addOptcxx f = alterSettings (\s -> s { sOpt_cxx = f : sOpt_cxx s})
-addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s
- , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s)
- })
- -- See Note [Repeated -optP hashing]
+setPgmP f = alterToolSettings (\s -> s { toolSettings_pgm_P = (pgm, map Option args)})
+ where (pgm:args) = words f
+addOptl f = alterToolSettings (\s -> s { toolSettings_opt_l = f : toolSettings_opt_l s})
+addOptc f = alterToolSettings (\s -> s { toolSettings_opt_c = f : toolSettings_opt_c s})
+addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s})
+addOptP f = alterToolSettings $ \s -> s
+ { toolSettings_opt_P = f : toolSettings_opt_P s
+ , toolSettings_opt_P_fingerprint = fingerprintStrings (f : toolSettings_opt_P s)
+ }
+ -- See Note [Repeated -optP hashing]
where
fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss
@@ -2710,27 +2735,6 @@ addGhciScript f d = d { ghciScripts = f : ghciScripts d}
setInteractivePrint f d = d { interactivePrint = Just f}
--- -----------------------------------------------------------------------------
--- Command-line options
-
--- | When invoking external tools as part of the compilation pipeline, we
--- pass these a sequence of options on the command-line. Rather than
--- just using a list of Strings, we use a type that allows us to distinguish
--- between filepaths and 'other stuff'. The reason for this is that
--- this type gives us a handle on transforming filenames, and filenames only,
--- to whatever format they're expected to be on a particular platform.
-data Option
- = FileOption -- an entry that _contains_ filename(s) / filepaths.
- String -- a non-filepath prefix that shouldn't be
- -- transformed (e.g., "/out=")
- String -- the filepath/filename portion
- | Option String
- deriving ( Eq )
-
-showOpt :: Option -> String
-showOpt (FileOption pre f) = pre ++ f
-showOpt (Option s) = s
-
-----------------------------------------------------------------------------
-- Setting the optimisation level
@@ -3031,64 +3035,66 @@ dynamic_flags_deps = [
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
, make_ord_flag defFlag "pgmlo"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lo = (f,[]) }
, make_ord_flag defFlag "pgmlc"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc = (f,[]) }
, make_ord_flag defFlag "pgmi"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_i = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i = f }
, make_ord_flag defFlag "pgmL"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_L = f }
, make_ord_flag defFlag "pgmP"
(hasArg setPgmP)
, make_ord_flag defFlag "pgmF"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_F = f }
, make_ord_flag defFlag "pgmc"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[]),
- -- Don't pass -no-pie with -pgmc
- -- (see #15319)
- sGccSupportsNoPie = False})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s
+ { toolSettings_pgm_c = (f,[])
+ , -- Don't pass -no-pie with -pgmc
+ -- (see #15319)
+ toolSettings_ccSupportsNoPie = False
+ }
, make_ord_flag defFlag "pgms"
(HasArg (\_ -> addWarn "Object splitting was removed in GHC 8.8"))
, make_ord_flag defFlag "pgma"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_a = (f,[]) }
, make_ord_flag defFlag "pgml"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_l = (f,[]) }
, make_ord_flag defFlag "pgmdll"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) }
, make_ord_flag defFlag "pgmwindres"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f }
, make_ord_flag defFlag "pgmlibtool"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_libtool = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f }
, make_ord_flag defFlag "pgmar"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_ar = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f }
, make_ord_flag defFlag "pgmranlib"
- (hasArg (\f -> alterSettings (\s -> s { sPgm_ranlib = f})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f }
-- need to appear before -optl/-opta to be parsed as LLVM flags.
, make_ord_flag defFlag "optlo"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lo = f : toolSettings_opt_lo s }
, make_ord_flag defFlag "optlc"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_lc = f : toolSettings_opt_lc s }
, make_ord_flag defFlag "opti"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_i = f : sOpt_i s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_i = f : toolSettings_opt_i s }
, make_ord_flag defFlag "optL"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_L = f : toolSettings_opt_L s }
, make_ord_flag defFlag "optP"
(hasArg addOptP)
, make_ord_flag defFlag "optF"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_F = f : toolSettings_opt_F s }
, make_ord_flag defFlag "optc"
(hasArg addOptc)
, make_ord_flag defFlag "optcxx"
(hasArg addOptcxx)
, make_ord_flag defFlag "opta"
- (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
+ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_a = f : toolSettings_opt_a s }
, make_ord_flag defFlag "optl"
(hasArg addOptl)
, make_ord_flag defFlag "optwindres"
- (hasArg (\f ->
- alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
+ $ hasArg $ \f ->
+ alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s }
, make_ord_flag defGhcFlag "split-objs"
(NoArg $ addWarn "ignoring -split-objs")
@@ -3732,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"
@@ -5107,8 +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 f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) }
+
+alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags
+alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) }
--------------------------
setDumpFlag' :: DumpFlag -> DynP ()
@@ -5415,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
@@ -5545,7 +5551,7 @@ splitPathList s = filter notNull (splitUp s)
-- tmpDir, where we store temporary files.
setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir })
+setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir }
-- we used to fix /cygdrive/c/.. on Windows, but this doesn't
-- seem necessary now --SDM 7/2/2008
@@ -5612,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 = []
@@ -5651,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 at .
@@ -5685,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
@@ -5776,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
@@ -5792,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
=====================================
compiler/main/FileSettings.hs
=====================================
@@ -0,0 +1,16 @@
+module FileSettings
+ ( FileSettings (..)
+ ) where
+
+import GhcPrelude
+
+-- | Paths to various files and directories used by GHC, including those that
+-- provide more settings.
+data FileSettings = FileSettings
+ { fileSettings_ghcUsagePath :: FilePath -- ditto
+ , fileSettings_ghciUsagePath :: FilePath -- ditto
+ , fileSettings_toolDir :: Maybe FilePath -- ditto
+ , fileSettings_topDir :: FilePath -- ditto
+ , fileSettings_tmpDir :: String -- no trailing '/'
+ , fileSettings_systemPackageConfig :: FilePath
+ }
=====================================
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
=====================================
compiler/main/GhcNameVersion.hs
=====================================
@@ -0,0 +1,11 @@
+module GhcNameVersion
+ ( GhcNameVersion (..)
+ ) where
+
+import GhcPrelude
+
+-- | Settings for what GHC this is.
+data GhcNameVersion = GhcNameVersion
+ { ghcNameVersion_programName :: String
+ , ghcNameVersion_projectVersion :: String
+ }
=====================================
compiler/main/Settings.hs
=====================================
@@ -0,0 +1,203 @@
+module Settings
+ ( Settings (..)
+ , sProgramName
+ , sProjectVersion
+ , sGhcUsagePath
+ , sGhciUsagePath
+ , sToolDir
+ , sTopDir
+ , sTmpDir
+ , sSystemPackageConfig
+ , sLdSupportsCompactUnwind
+ , sLdSupportsBuildId
+ , sLdSupportsFilelist
+ , sLdIsGnuLd
+ , sGccSupportsNoPie
+ , sPgm_L
+ , sPgm_P
+ , sPgm_F
+ , sPgm_c
+ , sPgm_a
+ , sPgm_l
+ , sPgm_dll
+ , sPgm_T
+ , sPgm_windres
+ , sPgm_libtool
+ , sPgm_ar
+ , sPgm_ranlib
+ , sPgm_lo
+ , sPgm_lc
+ , sPgm_lcc
+ , sPgm_i
+ , sOpt_L
+ , sOpt_P
+ , sOpt_P_fingerprint
+ , sOpt_F
+ , sOpt_c
+ , sOpt_cxx
+ , sOpt_a
+ , sOpt_l
+ , sOpt_windres
+ , sOpt_lo
+ , sOpt_lc
+ , sOpt_lcc
+ , sOpt_i
+ , sExtraGccViaCFlags
+ , sTargetPlatformString
+ , sIntegerLibrary
+ , sIntegerLibraryType
+ , sGhcWithInterpreter
+ , sGhcWithNativeCodeGen
+ , sGhcWithSMP
+ , sGhcRTSWays
+ , sTablesNextToCode
+ , sLeadingUnderscore
+ , sLibFFI
+ , sGhcThreaded
+ , sGhcDebugged
+ , sGhcRtsWithLibdw
+ ) where
+
+import GhcPrelude
+
+import CliOption
+import Fingerprint
+import FileSettings
+import GhcNameVersion
+import Platform
+import PlatformConstants
+import ToolSettings
+
+data Settings = Settings
+ { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion
+ , sFileSettings :: {-# UNPACK #-} !FileSettings
+ , sTargetPlatform :: Platform -- Filled in by SysTools
+ , sToolSettings :: {-# UNPACK #-} !ToolSettings
+ , sPlatformMisc :: {-# UNPACK #-} !PlatformMisc
+ , sPlatformConstants :: PlatformConstants
+
+ -- You shouldn't need to look things up in rawSettings directly.
+ -- They should have their own fields instead.
+ , sRawSettings :: [(String, String)]
+ }
+
+-----------------------------------------------------------------------------
+-- Accessessors from 'Settings'
+
+sProgramName :: Settings -> String
+sProgramName = ghcNameVersion_programName . sGhcNameVersion
+sProjectVersion :: Settings -> String
+sProjectVersion = ghcNameVersion_projectVersion . sGhcNameVersion
+
+sGhcUsagePath :: Settings -> FilePath
+sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings
+sGhciUsagePath :: Settings -> FilePath
+sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings
+sToolDir :: Settings -> Maybe FilePath
+sToolDir = fileSettings_toolDir . sFileSettings
+sTopDir :: Settings -> FilePath
+sTopDir = fileSettings_topDir . sFileSettings
+sTmpDir :: Settings -> String
+sTmpDir = fileSettings_tmpDir . sFileSettings
+sSystemPackageConfig :: Settings -> FilePath
+sSystemPackageConfig = fileSettings_systemPackageConfig . sFileSettings
+
+sLdSupportsCompactUnwind :: Settings -> Bool
+sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings
+sLdSupportsBuildId :: Settings -> Bool
+sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings
+sLdSupportsFilelist :: Settings -> Bool
+sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings
+sLdIsGnuLd :: Settings -> Bool
+sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings
+sGccSupportsNoPie :: Settings -> Bool
+sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings
+
+sPgm_L :: Settings -> String
+sPgm_L = toolSettings_pgm_L . sToolSettings
+sPgm_P :: Settings -> (String, [Option])
+sPgm_P = toolSettings_pgm_P . sToolSettings
+sPgm_F :: Settings -> String
+sPgm_F = toolSettings_pgm_F . sToolSettings
+sPgm_c :: Settings -> (String, [Option])
+sPgm_c = toolSettings_pgm_c . sToolSettings
+sPgm_a :: Settings -> (String, [Option])
+sPgm_a = toolSettings_pgm_a . sToolSettings
+sPgm_l :: Settings -> (String, [Option])
+sPgm_l = toolSettings_pgm_l . sToolSettings
+sPgm_dll :: Settings -> (String, [Option])
+sPgm_dll = toolSettings_pgm_dll . sToolSettings
+sPgm_T :: Settings -> String
+sPgm_T = toolSettings_pgm_T . sToolSettings
+sPgm_windres :: Settings -> String
+sPgm_windres = toolSettings_pgm_windres . sToolSettings
+sPgm_libtool :: Settings -> String
+sPgm_libtool = toolSettings_pgm_libtool . sToolSettings
+sPgm_ar :: Settings -> String
+sPgm_ar = toolSettings_pgm_ar . sToolSettings
+sPgm_ranlib :: Settings -> String
+sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings
+sPgm_lo :: Settings -> (String, [Option])
+sPgm_lo = toolSettings_pgm_lo . sToolSettings
+sPgm_lc :: Settings -> (String, [Option])
+sPgm_lc = toolSettings_pgm_lc . sToolSettings
+sPgm_lcc :: Settings -> (String, [Option])
+sPgm_lcc = toolSettings_pgm_lcc . sToolSettings
+sPgm_i :: Settings -> String
+sPgm_i = toolSettings_pgm_i . sToolSettings
+sOpt_L :: Settings -> [String]
+sOpt_L = toolSettings_opt_L . sToolSettings
+sOpt_P :: Settings -> [String]
+sOpt_P = toolSettings_opt_P . sToolSettings
+sOpt_P_fingerprint :: Settings -> Fingerprint
+sOpt_P_fingerprint = toolSettings_opt_P_fingerprint . sToolSettings
+sOpt_F :: Settings -> [String]
+sOpt_F = toolSettings_opt_F . sToolSettings
+sOpt_c :: Settings -> [String]
+sOpt_c = toolSettings_opt_c . sToolSettings
+sOpt_cxx :: Settings -> [String]
+sOpt_cxx = toolSettings_opt_cxx . sToolSettings
+sOpt_a :: Settings -> [String]
+sOpt_a = toolSettings_opt_a . sToolSettings
+sOpt_l :: Settings -> [String]
+sOpt_l = toolSettings_opt_l . sToolSettings
+sOpt_windres :: Settings -> [String]
+sOpt_windres = toolSettings_opt_windres . sToolSettings
+sOpt_lo :: Settings -> [String]
+sOpt_lo = toolSettings_opt_lo . sToolSettings
+sOpt_lc :: Settings -> [String]
+sOpt_lc = toolSettings_opt_lc . sToolSettings
+sOpt_lcc :: Settings -> [String]
+sOpt_lcc = toolSettings_opt_lcc . sToolSettings
+sOpt_i :: Settings -> [String]
+sOpt_i = toolSettings_opt_i . sToolSettings
+
+sExtraGccViaCFlags :: Settings -> [String]
+sExtraGccViaCFlags = toolSettings_extraGccViaCFlags . sToolSettings
+
+sTargetPlatformString :: Settings -> String
+sTargetPlatformString = platformMisc_targetPlatformString . sPlatformMisc
+sIntegerLibrary :: Settings -> String
+sIntegerLibrary = platformMisc_integerLibrary . sPlatformMisc
+sIntegerLibraryType :: Settings -> IntegerLibrary
+sIntegerLibraryType = platformMisc_integerLibraryType . sPlatformMisc
+sGhcWithInterpreter :: Settings -> Bool
+sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc
+sGhcWithNativeCodeGen :: Settings -> Bool
+sGhcWithNativeCodeGen = platformMisc_ghcWithNativeCodeGen . sPlatformMisc
+sGhcWithSMP :: Settings -> Bool
+sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc
+sGhcRTSWays :: Settings -> String
+sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc
+sTablesNextToCode :: Settings -> Bool
+sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc
+sLeadingUnderscore :: Settings -> Bool
+sLeadingUnderscore = platformMisc_leadingUnderscore . sPlatformMisc
+sLibFFI :: Settings -> Bool
+sLibFFI = platformMisc_libFFI . sPlatformMisc
+sGhcThreaded :: Settings -> Bool
+sGhcThreaded = platformMisc_ghcThreaded . sPlatformMisc
+sGhcDebugged :: Settings -> Bool
+sGhcDebugged = platformMisc_ghcDebugged . sPlatformMisc
+sGhcRtsWithLibdw :: Settings -> Bool
+sGhcRtsWithLibdw = platformMisc_ghcRtsWithLibdw . sPlatformMisc
=====================================
compiler/main/SysTools.hs
=====================================
@@ -49,6 +49,7 @@ import Platform
import Util
import DynFlags
import Fingerprint
+import ToolSettings
import System.FilePath
import System.IO
@@ -282,68 +283,82 @@ initSysTools top_dir
ghcDebugged <- getBooleanSetting "Use Debugging"
ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw"
- return $ Settings {
- sTargetPlatform = platform,
- sTmpDir = normalise tmpdir,
- sGhcUsagePath = ghc_usage_msg_path,
- sGhciUsagePath = ghci_usage_msg_path,
- sToolDir = mtool_dir,
- sTopDir = top_dir,
- sRawSettings = mySettings,
- sExtraGccViaCFlags = words myExtraGccViaCFlags,
- sSystemPackageConfig = pkgconfig_path,
- sLdSupportsCompactUnwind = ldSupportsCompactUnwind,
- sLdSupportsBuildId = ldSupportsBuildId,
- sLdSupportsFilelist = ldSupportsFilelist,
- sLdIsGnuLd = ldIsGnuLd,
- sGccSupportsNoPie = gccSupportsNoPie,
- sProgramName = "ghc",
- sProjectVersion = cProjectVersion,
- sPgm_L = unlit_path,
- sPgm_P = (cpp_prog, cpp_args),
- sPgm_F = "",
- sPgm_c = (gcc_prog, gcc_args),
- sPgm_a = (as_prog, as_args),
- sPgm_l = (ld_prog, ld_args),
- sPgm_dll = (mkdll_prog,mkdll_args),
- sPgm_T = touch_path,
- sPgm_windres = windres_path,
- sPgm_libtool = libtool_path,
- sPgm_ar = ar_path,
- sPgm_ranlib = ranlib_path,
- sPgm_lo = (lo_prog,[]),
- sPgm_lc = (lc_prog,[]),
- sPgm_lcc = (lcc_prog,[]),
- sPgm_i = iserv_prog,
- sOpt_L = [],
- sOpt_P = [],
- sOpt_P_fingerprint = fingerprint0,
- sOpt_F = [],
- sOpt_c = [],
- sOpt_cxx = [],
- sOpt_a = [],
- sOpt_l = [],
- sOpt_windres = [],
- sOpt_lcc = [],
- sOpt_lo = [],
- sOpt_lc = [],
- sOpt_i = [],
- sPlatformConstants = platformConstants,
-
- sTargetPlatformString = targetPlatformString,
- sIntegerLibrary = integerLibrary,
- sIntegerLibraryType = integerLibraryType,
- sGhcWithInterpreter = ghcWithInterpreter,
- sGhcWithNativeCodeGen = ghcWithNativeCodeGen,
- sGhcWithSMP = ghcWithSMP,
- sGhcRTSWays = ghcRTSWays,
- sTablesNextToCode = tablesNextToCode,
- sLeadingUnderscore = leadingUnderscore,
- sLibFFI = useLibFFI,
- sGhcThreaded = ghcThreaded,
- sGhcDebugged = ghcDebugged,
- sGhcRtsWithLibdw = ghcRtsWithLibdw
- }
+ return $ Settings
+ { sGhcNameVersion = GhcNameVersion
+ { ghcNameVersion_programName = "ghc"
+ , ghcNameVersion_projectVersion = cProjectVersion
+ }
+
+ , sFileSettings = FileSettings
+ { fileSettings_tmpDir = normalise tmpdir
+ , fileSettings_ghcUsagePath = ghc_usage_msg_path
+ , fileSettings_ghciUsagePath = ghci_usage_msg_path
+ , fileSettings_toolDir = mtool_dir
+ , fileSettings_topDir = top_dir
+ , fileSettings_systemPackageConfig = pkgconfig_path
+ }
+
+ , sToolSettings = ToolSettings
+ { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
+ , toolSettings_ldSupportsBuildId = ldSupportsBuildId
+ , toolSettings_ldSupportsFilelist = ldSupportsFilelist
+ , toolSettings_ldIsGnuLd = ldIsGnuLd
+ , toolSettings_ccSupportsNoPie = gccSupportsNoPie
+
+ , toolSettings_pgm_L = unlit_path
+ , toolSettings_pgm_P = (cpp_prog, cpp_args)
+ , toolSettings_pgm_F = ""
+ , toolSettings_pgm_c = (gcc_prog, gcc_args)
+ , toolSettings_pgm_a = (as_prog, as_args)
+ , toolSettings_pgm_l = (ld_prog, ld_args)
+ , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
+ , toolSettings_pgm_T = touch_path
+ , toolSettings_pgm_windres = windres_path
+ , toolSettings_pgm_libtool = libtool_path
+ , toolSettings_pgm_ar = ar_path
+ , toolSettings_pgm_ranlib = ranlib_path
+ , toolSettings_pgm_lo = (lo_prog,[])
+ , toolSettings_pgm_lc = (lc_prog,[])
+ , toolSettings_pgm_lcc = (lcc_prog,[])
+ , toolSettings_pgm_i = iserv_prog
+ , toolSettings_opt_L = []
+ , toolSettings_opt_P = []
+ , toolSettings_opt_P_fingerprint = fingerprint0
+ , toolSettings_opt_F = []
+ , toolSettings_opt_c = []
+ , toolSettings_opt_cxx = []
+ , toolSettings_opt_a = []
+ , toolSettings_opt_l = []
+ , toolSettings_opt_windres = []
+ , toolSettings_opt_lcc = []
+ , toolSettings_opt_lo = []
+ , toolSettings_opt_lc = []
+ , toolSettings_opt_i = []
+
+ , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags
+ }
+
+ , sTargetPlatform = platform
+ , sPlatformMisc = PlatformMisc
+ { platformMisc_targetPlatformString = targetPlatformString
+ , platformMisc_integerLibrary = integerLibrary
+ , platformMisc_integerLibraryType = integerLibraryType
+ , platformMisc_ghcWithInterpreter = ghcWithInterpreter
+ , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
+ , platformMisc_ghcWithSMP = ghcWithSMP
+ , platformMisc_ghcRTSWays = ghcRTSWays
+ , platformMisc_tablesNextToCode = tablesNextToCode
+ , platformMisc_leadingUnderscore = leadingUnderscore
+ , platformMisc_libFFI = useLibFFI
+ , platformMisc_ghcThreaded = ghcThreaded
+ , platformMisc_ghcDebugged = ghcDebugged
+ , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw
+ }
+
+ , sPlatformConstants = platformConstants
+
+ , sRawSettings = mySettings
+ }
{- Note [Windows stack usage]
@@ -418,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
=====================================
compiler/main/ToolSettings.hs
=====================================
@@ -0,0 +1,64 @@
+module ToolSettings
+ ( ToolSettings (..)
+ ) where
+
+import GhcPrelude
+
+import CliOption
+import Fingerprint
+
+-- | Settings for other executables GHC calls.
+--
+-- Probably should futher split down by phase, or split between
+-- platform-specific and platform-agnostic.
+data ToolSettings = ToolSettings
+ { toolSettings_ldSupportsCompactUnwind :: Bool
+ , toolSettings_ldSupportsBuildId :: Bool
+ , toolSettings_ldSupportsFilelist :: Bool
+ , toolSettings_ldIsGnuLd :: Bool
+ , toolSettings_ccSupportsNoPie :: Bool
+
+ -- commands for particular phases
+ , toolSettings_pgm_L :: String
+ , toolSettings_pgm_P :: (String, [Option])
+ , toolSettings_pgm_F :: String
+ , toolSettings_pgm_c :: (String, [Option])
+ , toolSettings_pgm_a :: (String, [Option])
+ , toolSettings_pgm_l :: (String, [Option])
+ , toolSettings_pgm_dll :: (String, [Option])
+ , toolSettings_pgm_T :: String
+ , toolSettings_pgm_windres :: String
+ , toolSettings_pgm_libtool :: String
+ , toolSettings_pgm_ar :: String
+ , toolSettings_pgm_ranlib :: String
+ , -- | LLVM: opt llvm optimiser
+ toolSettings_pgm_lo :: (String, [Option])
+ , -- | LLVM: llc static compiler
+ toolSettings_pgm_lc :: (String, [Option])
+ , -- | LLVM: c compiler
+ toolSettings_pgm_lcc :: (String, [Option])
+ , toolSettings_pgm_i :: String
+
+ -- options for particular phases
+ , toolSettings_opt_L :: [String]
+ , toolSettings_opt_P :: [String]
+ , -- | cached Fingerprint of sOpt_P
+ -- See Note [Repeated -optP hashing]
+ toolSettings_opt_P_fingerprint :: Fingerprint
+ , toolSettings_opt_F :: [String]
+ , toolSettings_opt_c :: [String]
+ , toolSettings_opt_cxx :: [String]
+ , toolSettings_opt_a :: [String]
+ , toolSettings_opt_l :: [String]
+ , toolSettings_opt_windres :: [String]
+ , -- | LLVM: llvm optimiser
+ toolSettings_opt_lo :: [String]
+ , -- | LLVM: llc static compiler
+ toolSettings_opt_lc :: [String]
+ , -- | LLVM: c compiler
+ toolSettings_opt_lcc :: [String]
+ , -- | iserv options
+ toolSettings_opt_i :: [String]
+
+ , toolSettings_extraGccViaCFlags :: [String]
+ }
=====================================
compiler/utils/Platform.hs
=====================================
@@ -16,6 +16,9 @@ module Platform (
osMachOTarget,
osSubsectionsViaSymbols,
platformUsesFrameworks,
+
+ PlatformMisc(..),
+ IntegerLibrary(..),
)
where
@@ -160,3 +163,28 @@ osSubsectionsViaSymbols :: OS -> Bool
osSubsectionsViaSymbols OSDarwin = True
osSubsectionsViaSymbols _ = False
+-- | Platform-specific settings formerly hard-coded in Config.hs.
+--
+-- These should probably be all be triaged whether they can be computed from
+-- other settings or belong in another another place (like 'Platform' above).
+data PlatformMisc = PlatformMisc
+ { -- TODO Recalculate string from richer info?
+ platformMisc_targetPlatformString :: String
+ , platformMisc_integerLibrary :: String
+ , platformMisc_integerLibraryType :: IntegerLibrary
+ , platformMisc_ghcWithInterpreter :: Bool
+ , platformMisc_ghcWithNativeCodeGen :: Bool
+ , platformMisc_ghcWithSMP :: Bool
+ , platformMisc_ghcRTSWays :: String
+ , platformMisc_tablesNextToCode :: Bool
+ , platformMisc_leadingUnderscore :: Bool
+ , platformMisc_libFFI :: Bool
+ , platformMisc_ghcThreaded :: Bool
+ , platformMisc_ghcDebugged :: Bool
+ , platformMisc_ghcRtsWithLibdw :: Bool
+ }
+
+data IntegerLibrary
+ = IntegerGMP
+ | IntegerSimple
+ deriving (Read, Show, Eq)
=====================================
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
=====================================
hadrian/src/Rules/Libffi.hs
=====================================
@@ -13,6 +13,35 @@ import Settings.Builders.Common
import Target
import Utilities
+{- Note [Libffi indicating inputs]
+
+First see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian for an
+explanation of "indicating input". Part of the definition is copied here for
+your convenience:
+
+ change in the vital output -> change in the indicating inputs
+
+In the case of building libffi `vital output = built libffi library files` and
+we can consider the libffi archive file (i.e. the "libffi-tarballs/libffi*.tar.gz"
+file) to be the only indicating input besides the build tools (e.g. make).
+Note building libffi is split into a few rules, but we also expect that:
+
+ no change in the archive file -> no change in the intermediate build artifacts
+
+and so the archive file is still a valid choice of indicating input for
+all libffi rules. Hence we can get away with `need`ing only the archive file and
+don't have to `need` intermediate build artifacts (besides those to trigger
+dependant libffi rules i.e. to generate vital inputs as is noted on the wiki).
+It is then safe to `trackAllow` the libffi build directory as is done in
+`needLibfffiArchive`.
+
+A disadvantage to this approach is that changing the archive file forces a clean
+build of libffi i.e. we cannot incrementally build libffi. This seems like a
+performance issue, but is justified as building libffi is fast and the archive
+file is rarely changed.
+
+-}
+
-- | Oracle question type. The oracle returns the list of dynamic
-- libffi library file paths (all but one of which should be symlinks).
newtype LibffiDynLibs = LibffiDynLibs Stage
@@ -105,13 +134,7 @@ configureEnvironment stage = do
, return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
-- Need the libffi archive and `trackAllow` all files in the build directory.
--- As all libffi build files are derived from this archive, we can safely
--- `trackAllow` the libffi build dir. I.e the archive file can be seen as a
--- shallow dependency of the libffi build. This is much simpler than working out
--- the dependencies of each rule (within the build dir).
--- This means changing the archive file forces a clean build of libffi. This
--- seems like a performance issue, but is justified as building libffi is fast
--- and the archive file is rarely changed.
+-- See [Libffi indicating inputs].
needLibfffiArchive :: FilePath -> Action FilePath
needLibfffiArchive buildPath = do
top <- topDirectory
@@ -148,19 +171,15 @@ libffiRules = do
dynLibFiles <- do
windows <- windowsHost
osx <- osxHost
- let libffiName'' = libffiName' windows True
- if windows
- then
- let libffiDll = "lib" ++ libffiName'' ++ ".dll"
- in return [libffiPath -/- "inst/bin" -/- libffiDll]
- else do
- let libffiLibPath = libffiPath -/- "inst/lib"
- dynLibsRelative <- liftIO $ getDirectoryFilesIO
- libffiLibPath
- (if osx
- then ["lib" ++ libffiName'' ++ ".dylib*"]
- else ["lib" ++ libffiName'' ++ ".so*"])
- return (fmap (libffiLibPath -/-) dynLibsRelative)
+ let libfilesDir = libffiPath -/-
+ (if windows then "inst" -/- "bin" else "inst" -/- "lib")
+ libffiName'' = libffiName' windows True
+ dynlibext
+ | windows = "dll"
+ | osx = "dylib"
+ | otherwise = "so"
+ filepat = "lib" ++ libffiName'' ++ "*." ++ dynlibext ++ "*"
+ liftIO $ getDirectoryFilesIO "." [libfilesDir -/- filepat]
writeFileLines dynLibMan dynLibFiles
putSuccess "| Successfully build libffi."
=====================================
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
*/
=====================================
rts/linker/MachO.c
=====================================
@@ -1122,8 +1122,12 @@ ocBuildSegments_MachO(ObjectCode *oc)
n_activeSegments++;
}
- mem = mmapForLinker(size_compound, MAP_ANON, -1, 0);
- if (NULL == mem) return 0;
+ // N.B. it's possible that there is nothing mappable in an object. In this
+ // case we avoid the mmap call since it would fail. See #16701.
+ if (size_compound > 0) {
+ mem = mmapForLinker(size_compound, MAP_ANON, -1, 0);
+ if (NULL == mem) return 0;
+ }
IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments));
segments = (Segment*)stgCallocBytes(n_activeSegments, sizeof(Segment),
=====================================
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 {}) = []
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bf67d9e6e652d35d6042a54205997219d8c21663...c511fd4e09318ff106a996e9d4bb2d613e2aae33
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/bf67d9e6e652d35d6042a54205997219d8c21663...c511fd4e09318ff106a996e9d4bb2d613e2aae33
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190529/3879b94e/attachment-0001.html>
More information about the ghc-commits
mailing list