never executed always true always false
1
2
3 -- | Run-time settings
4 module GHC.Settings
5 ( Settings (..)
6 , ToolSettings (..)
7 , FileSettings (..)
8 , GhcNameVersion (..)
9 , Platform (..)
10 , PlatformMisc (..)
11 -- * Accessors
12 , dynLibSuffix
13 , sProgramName
14 , sProjectVersion
15 , sGhcUsagePath
16 , sGhciUsagePath
17 , sToolDir
18 , sTopDir
19 , sGlobalPackageDatabasePath
20 , sLdSupportsCompactUnwind
21 , sLdSupportsBuildId
22 , sLdSupportsFilelist
23 , sLdIsGnuLd
24 , sGccSupportsNoPie
25 , sPgm_L
26 , sPgm_P
27 , sPgm_F
28 , sPgm_c
29 , sPgm_a
30 , sPgm_l
31 , sPgm_lm
32 , sPgm_dll
33 , sPgm_T
34 , sPgm_windres
35 , sPgm_libtool
36 , sPgm_ar
37 , sPgm_otool
38 , sPgm_install_name_tool
39 , sPgm_ranlib
40 , sPgm_lo
41 , sPgm_lc
42 , sPgm_lcc
43 , sPgm_i
44 , sOpt_L
45 , sOpt_P
46 , sOpt_P_fingerprint
47 , sOpt_F
48 , sOpt_c
49 , sOpt_cxx
50 , sOpt_a
51 , sOpt_l
52 , sOpt_lm
53 , sOpt_windres
54 , sOpt_lo
55 , sOpt_lc
56 , sOpt_lcc
57 , sOpt_i
58 , sExtraGccViaCFlags
59 , sTargetPlatformString
60 , sGhcWithInterpreter
61 , sLibFFI
62 ) where
63
64 import GHC.Prelude
65
66 import GHC.Utils.CliOption
67 import GHC.Utils.Fingerprint
68 import GHC.Platform
69
70 data Settings = Settings
71 { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion
72 , sFileSettings :: {-# UNPACK #-} !FileSettings
73 , sTargetPlatform :: Platform -- Filled in by SysTools
74 , sToolSettings :: {-# UNPACK #-} !ToolSettings
75 , sPlatformMisc :: {-# UNPACK #-} !PlatformMisc
76
77 -- You shouldn't need to look things up in rawSettings directly.
78 -- They should have their own fields instead.
79 , sRawSettings :: [(String, String)]
80 }
81
82 -- | Settings for other executables GHC calls.
83 --
84 -- Probably should further split down by phase, or split between
85 -- platform-specific and platform-agnostic.
86 data ToolSettings = ToolSettings
87 { toolSettings_ldSupportsCompactUnwind :: Bool
88 , toolSettings_ldSupportsBuildId :: Bool
89 , toolSettings_ldSupportsFilelist :: Bool
90 , toolSettings_ldIsGnuLd :: Bool
91 , toolSettings_ccSupportsNoPie :: Bool
92
93 -- commands for particular phases
94 , toolSettings_pgm_L :: String
95 , toolSettings_pgm_P :: (String, [Option])
96 , toolSettings_pgm_F :: String
97 , toolSettings_pgm_c :: String
98 , toolSettings_pgm_a :: (String, [Option])
99 , toolSettings_pgm_l :: (String, [Option])
100 , toolSettings_pgm_lm :: (String, [Option])
101 , toolSettings_pgm_dll :: (String, [Option])
102 , toolSettings_pgm_T :: String
103 , toolSettings_pgm_windres :: String
104 , toolSettings_pgm_libtool :: String
105 , toolSettings_pgm_ar :: String
106 , toolSettings_pgm_otool :: String
107 , toolSettings_pgm_install_name_tool :: String
108 , toolSettings_pgm_ranlib :: String
109 , -- | LLVM: opt llvm optimiser
110 toolSettings_pgm_lo :: (String, [Option])
111 , -- | LLVM: llc static compiler
112 toolSettings_pgm_lc :: (String, [Option])
113 , -- | LLVM: c compiler
114 toolSettings_pgm_lcc :: (String, [Option])
115 , toolSettings_pgm_i :: String
116
117 -- options for particular phases
118 , toolSettings_opt_L :: [String]
119 , toolSettings_opt_P :: [String]
120 , -- | cached Fingerprint of sOpt_P
121 -- See Note [Repeated -optP hashing]
122 toolSettings_opt_P_fingerprint :: Fingerprint
123 , toolSettings_opt_F :: [String]
124 , toolSettings_opt_c :: [String]
125 , toolSettings_opt_cxx :: [String]
126 , toolSettings_opt_a :: [String]
127 , toolSettings_opt_l :: [String]
128 , toolSettings_opt_lm :: [String]
129 , toolSettings_opt_windres :: [String]
130 , -- | LLVM: llvm optimiser
131 toolSettings_opt_lo :: [String]
132 , -- | LLVM: llc static compiler
133 toolSettings_opt_lc :: [String]
134 , -- | LLVM: c compiler
135 toolSettings_opt_lcc :: [String]
136 , -- | iserv options
137 toolSettings_opt_i :: [String]
138
139 , toolSettings_extraGccViaCFlags :: [String]
140 }
141
142
143 -- | Paths to various files and directories used by GHC, including those that
144 -- provide more settings.
145 data FileSettings = FileSettings
146 { fileSettings_ghcUsagePath :: FilePath -- ditto
147 , fileSettings_ghciUsagePath :: FilePath -- ditto
148 , fileSettings_toolDir :: Maybe FilePath -- ditto
149 , fileSettings_topDir :: FilePath -- ditto
150 , fileSettings_globalPackageDatabase :: FilePath
151 }
152
153
154 -- | Settings for what GHC this is.
155 data GhcNameVersion = GhcNameVersion
156 { ghcNameVersion_programName :: String
157 , ghcNameVersion_projectVersion :: String
158 }
159
160 -- | Dynamic library suffix
161 dynLibSuffix :: GhcNameVersion -> String
162 dynLibSuffix (GhcNameVersion name ver) = '-':name ++ ver
163
164 -----------------------------------------------------------------------------
165 -- Accessessors from 'Settings'
166
167 sProgramName :: Settings -> String
168 sProgramName = ghcNameVersion_programName . sGhcNameVersion
169 sProjectVersion :: Settings -> String
170 sProjectVersion = ghcNameVersion_projectVersion . sGhcNameVersion
171
172 sGhcUsagePath :: Settings -> FilePath
173 sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings
174 sGhciUsagePath :: Settings -> FilePath
175 sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings
176 sToolDir :: Settings -> Maybe FilePath
177 sToolDir = fileSettings_toolDir . sFileSettings
178 sTopDir :: Settings -> FilePath
179 sTopDir = fileSettings_topDir . sFileSettings
180 sGlobalPackageDatabasePath :: Settings -> FilePath
181 sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings
182
183 sLdSupportsCompactUnwind :: Settings -> Bool
184 sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings
185 sLdSupportsBuildId :: Settings -> Bool
186 sLdSupportsBuildId = toolSettings_ldSupportsBuildId . sToolSettings
187 sLdSupportsFilelist :: Settings -> Bool
188 sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings
189 sLdIsGnuLd :: Settings -> Bool
190 sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings
191 sGccSupportsNoPie :: Settings -> Bool
192 sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings
193
194 sPgm_L :: Settings -> String
195 sPgm_L = toolSettings_pgm_L . sToolSettings
196 sPgm_P :: Settings -> (String, [Option])
197 sPgm_P = toolSettings_pgm_P . sToolSettings
198 sPgm_F :: Settings -> String
199 sPgm_F = toolSettings_pgm_F . sToolSettings
200 sPgm_c :: Settings -> String
201 sPgm_c = toolSettings_pgm_c . sToolSettings
202 sPgm_a :: Settings -> (String, [Option])
203 sPgm_a = toolSettings_pgm_a . sToolSettings
204 sPgm_l :: Settings -> (String, [Option])
205 sPgm_l = toolSettings_pgm_l . sToolSettings
206 sPgm_lm :: Settings -> (String, [Option])
207 sPgm_lm = toolSettings_pgm_lm . sToolSettings
208 sPgm_dll :: Settings -> (String, [Option])
209 sPgm_dll = toolSettings_pgm_dll . sToolSettings
210 sPgm_T :: Settings -> String
211 sPgm_T = toolSettings_pgm_T . sToolSettings
212 sPgm_windres :: Settings -> String
213 sPgm_windres = toolSettings_pgm_windres . sToolSettings
214 sPgm_libtool :: Settings -> String
215 sPgm_libtool = toolSettings_pgm_libtool . sToolSettings
216 sPgm_ar :: Settings -> String
217 sPgm_ar = toolSettings_pgm_ar . sToolSettings
218 sPgm_otool :: Settings -> String
219 sPgm_otool = toolSettings_pgm_otool . sToolSettings
220 sPgm_install_name_tool :: Settings -> String
221 sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings
222 sPgm_ranlib :: Settings -> String
223 sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings
224 sPgm_lo :: Settings -> (String, [Option])
225 sPgm_lo = toolSettings_pgm_lo . sToolSettings
226 sPgm_lc :: Settings -> (String, [Option])
227 sPgm_lc = toolSettings_pgm_lc . sToolSettings
228 sPgm_lcc :: Settings -> (String, [Option])
229 sPgm_lcc = toolSettings_pgm_lcc . sToolSettings
230 sPgm_i :: Settings -> String
231 sPgm_i = toolSettings_pgm_i . sToolSettings
232 sOpt_L :: Settings -> [String]
233 sOpt_L = toolSettings_opt_L . sToolSettings
234 sOpt_P :: Settings -> [String]
235 sOpt_P = toolSettings_opt_P . sToolSettings
236 sOpt_P_fingerprint :: Settings -> Fingerprint
237 sOpt_P_fingerprint = toolSettings_opt_P_fingerprint . sToolSettings
238 sOpt_F :: Settings -> [String]
239 sOpt_F = toolSettings_opt_F . sToolSettings
240 sOpt_c :: Settings -> [String]
241 sOpt_c = toolSettings_opt_c . sToolSettings
242 sOpt_cxx :: Settings -> [String]
243 sOpt_cxx = toolSettings_opt_cxx . sToolSettings
244 sOpt_a :: Settings -> [String]
245 sOpt_a = toolSettings_opt_a . sToolSettings
246 sOpt_l :: Settings -> [String]
247 sOpt_l = toolSettings_opt_l . sToolSettings
248 sOpt_lm :: Settings -> [String]
249 sOpt_lm = toolSettings_opt_lm . sToolSettings
250 sOpt_windres :: Settings -> [String]
251 sOpt_windres = toolSettings_opt_windres . sToolSettings
252 sOpt_lo :: Settings -> [String]
253 sOpt_lo = toolSettings_opt_lo . sToolSettings
254 sOpt_lc :: Settings -> [String]
255 sOpt_lc = toolSettings_opt_lc . sToolSettings
256 sOpt_lcc :: Settings -> [String]
257 sOpt_lcc = toolSettings_opt_lcc . sToolSettings
258 sOpt_i :: Settings -> [String]
259 sOpt_i = toolSettings_opt_i . sToolSettings
260
261 sExtraGccViaCFlags :: Settings -> [String]
262 sExtraGccViaCFlags = toolSettings_extraGccViaCFlags . sToolSettings
263
264 sTargetPlatformString :: Settings -> String
265 sTargetPlatformString = platformMisc_targetPlatformString . sPlatformMisc
266 sGhcWithInterpreter :: Settings -> Bool
267 sGhcWithInterpreter = platformMisc_ghcWithInterpreter . sPlatformMisc
268 sLibFFI :: Settings -> Bool
269 sLibFFI = platformMisc_libFFI . sPlatformMisc