Minor clean up, taking hlint suggestions
[ghc.git] / src / Oracles / Setting.hs
1 module Oracles.Setting (
2 configFile, Setting (..), SettingList (..), setting, settingList, getSetting,
3 getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
4 ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
5 ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
6 topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf
7 ) where
8
9 import Hadrian.Expression
10 import Hadrian.Oracles.TextFile
11 import Hadrian.Oracles.Path
12
13 import Base
14
15 -- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
16 -- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
17 -- @setting TargetOs@ looks up the config file and returns "mingw32".
18 -- 'SettingList' is used for multiple string values separated by spaces, such
19 -- as @gmp-include-dirs = a b@.
20 -- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
21 data Setting = BuildArch
22 | BuildOs
23 | BuildPlatform
24 | BuildVendor
25 | CcClangBackend
26 | CcLlvmBackend
27 | DynamicExtension
28 | GhcMajorVersion
29 | GhcMinorVersion
30 | GhcPatchLevel
31 | GhcVersion
32 | GhcSourcePath
33 | HostArch
34 | HostOs
35 | HostPlatform
36 | HostVendor
37 | ProjectGitCommitId
38 | ProjectName
39 | ProjectVersion
40 | ProjectVersionInt
41 | ProjectPatchLevel
42 | ProjectPatchLevel1
43 | ProjectPatchLevel2
44 | TargetArch
45 | TargetOs
46 | TargetPlatform
47 | TargetPlatformFull
48 | TargetVendor
49 | LlvmTarget
50 | FfiIncludeDir
51 | FfiLibDir
52 | GmpIncludeDir
53 | GmpLibDir
54 | IconvIncludeDir
55 | IconvLibDir
56 | CursesLibDir
57 -- Paths to where GHC is installed (ref: mk/install.mk)
58 | InstallPrefix
59 | InstallBinDir
60 | InstallLibDir
61 | InstallDataRootDir
62 -- Command lines for invoking the @install@ utility
63 | Install
64 | InstallData
65 | InstallProgram
66 | InstallScript
67 | InstallDir
68 -- Command line for creating a symbolic link
69 | LnS
70
71 data SettingList = ConfCcArgs Stage
72 | ConfCppArgs Stage
73 | ConfGccLinkerArgs Stage
74 | ConfLdLinkerArgs Stage
75 | HsCppArgs
76
77 -- | Maps 'Setting's to names in @cfg/system.config.in@.
78 setting :: Setting -> Action String
79 setting key = lookupValueOrError configFile $ case key of
80 BuildArch -> "build-arch"
81 BuildOs -> "build-os"
82 BuildPlatform -> "build-platform"
83 BuildVendor -> "build-vendor"
84 CcClangBackend -> "cc-clang-backend"
85 CcLlvmBackend -> "cc-llvm-backend"
86 DynamicExtension -> "dynamic-extension"
87 GhcMajorVersion -> "ghc-major-version"
88 GhcMinorVersion -> "ghc-minor-version"
89 GhcPatchLevel -> "ghc-patch-level"
90 GhcVersion -> "ghc-version"
91 GhcSourcePath -> "ghc-source-path"
92 HostArch -> "host-arch"
93 HostOs -> "host-os"
94 HostPlatform -> "host-platform"
95 HostVendor -> "host-vendor"
96 ProjectGitCommitId -> "project-git-commit-id"
97 ProjectName -> "project-name"
98 ProjectVersion -> "project-version"
99 ProjectVersionInt -> "project-version-int"
100 ProjectPatchLevel -> "project-patch-level"
101 ProjectPatchLevel1 -> "project-patch-level1"
102 ProjectPatchLevel2 -> "project-patch-level2"
103 TargetArch -> "target-arch"
104 TargetOs -> "target-os"
105 TargetPlatform -> "target-platform"
106 TargetPlatformFull -> "target-platform-full"
107 TargetVendor -> "target-vendor"
108 LlvmTarget -> "llvm-target"
109 FfiIncludeDir -> "ffi-include-dir"
110 FfiLibDir -> "ffi-lib-dir"
111 GmpIncludeDir -> "gmp-include-dir"
112 GmpLibDir -> "gmp-lib-dir"
113 IconvIncludeDir -> "iconv-include-dir"
114 IconvLibDir -> "iconv-lib-dir"
115 CursesLibDir -> "curses-lib-dir"
116 InstallPrefix -> "install-prefix"
117 InstallBinDir -> "install-bindir"
118 InstallLibDir -> "install-libdir"
119 InstallDataRootDir -> "install-datarootdir"
120 Install -> "install"
121 InstallDir -> "install-dir"
122 InstallProgram -> "install-program"
123 InstallScript -> "install-script"
124 InstallData -> "install-data"
125 LnS -> "ln-s"
126
127 settingList :: SettingList -> Action [String]
128 settingList key = fmap words $ lookupValueOrError configFile $ case key of
129 ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage
130 ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage
131 ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage
132 ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage
133 HsCppArgs -> "hs-cpp-args"
134
135 -- | Get a configuration setting.
136 getSetting :: Setting -> Expr c b String
137 getSetting = expr . setting
138
139 -- | Get a list of configuration settings.
140 getSettingList :: SettingList -> Args c b
141 getSettingList = expr . settingList
142
143 matchSetting :: Setting -> [String] -> Action Bool
144 matchSetting key values = (`elem` values) <$> setting key
145
146 anyTargetPlatform :: [String] -> Action Bool
147 anyTargetPlatform = matchSetting TargetPlatformFull
148
149 anyTargetOs :: [String] -> Action Bool
150 anyTargetOs = matchSetting TargetOs
151
152 anyTargetArch :: [String] -> Action Bool
153 anyTargetArch = matchSetting TargetArch
154
155 anyHostOs :: [String] -> Action Bool
156 anyHostOs = matchSetting HostOs
157
158 iosHost :: Action Bool
159 iosHost = anyHostOs ["ios"]
160
161 osxHost :: Action Bool
162 osxHost = anyHostOs ["darwin"]
163
164 windowsHost :: Action Bool
165 windowsHost = anyHostOs ["mingw32", "cygwin32"]
166
167 ghcWithInterpreter :: Action Bool
168 ghcWithInterpreter = do
169 goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
170 , "freebsd", "dragonfly", "netbsd", "openbsd"
171 , "darwin", "kfreebsdgnu" ]
172 goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc"
173 , "sparc64", "arm" ]
174 return $ goodOs && goodArch
175
176 ghcEnableTablesNextToCode :: Action Bool
177 ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]
178
179 useLibFFIForAdjustors :: Action Bool
180 useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
181
182 -- | Canonicalised GHC version number, used for integer version comparisons. We
183 -- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
184 ghcCanonVersion :: Action String
185 ghcCanonVersion = do
186 ghcMajorVersion <- setting GhcMajorVersion
187 ghcMinorVersion <- setting GhcMinorVersion
188 let leadingZero = [ '0' | length ghcMinorVersion == 1 ]
189 return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion
190
191 -- ref: https://ghc.haskell.org/trac/ghc/wiki/Building/Installing#HowGHCfindsitsfiles
192 -- | On Windows we normally build a relocatable installation, which assumes that
193 -- the library directory @libdir@ is in a fixed location relative to the GHC
194 -- binary, namely @../lib@.
195 relocatableBuild :: Action Bool
196 relocatableBuild = windowsHost
197
198 installDocDir :: Action String
199 installDocDir = do
200 version <- setting ProjectVersion
201 dataDir <- setting InstallDataRootDir
202 return $ dataDir -/- ("doc/ghc-" ++ version)
203
204 -- | Path to the GHC source tree.
205 topDirectory :: Action FilePath
206 topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
207
208 -- ref: mk/install.mk:101
209 -- TODO: CroosCompilePrefix
210 -- | Unix: override @libdir@ and @datadir@ to put GHC-specific files in a
211 -- subdirectory with the version number included.
212 installGhcLibDir :: Action String
213 installGhcLibDir = do
214 rBuild <- relocatableBuild
215 libdir <- setting InstallLibDir
216 if rBuild then return libdir
217 else do
218 version <- setting ProjectVersion
219 return $ libdir -/- ("ghc-" ++ version)
220
221 -- TODO: find out why we need version number in the dynamic suffix
222 -- The current theory: dynamic libraries are eventually placed in a single
223 -- giant directory in the load path of the dynamic linker, and hence we must
224 -- distinguish different versions of GHC. In contrast static libraries live
225 -- in their own per-package directory and hence do not need a unique filename.
226 -- We also need to respect the system's dynamic extension, e.g. .dll or .so.
227 libsuf :: Way -> Action String
228 libsuf way =
229 if not (wayUnit Dynamic way)
230 then return $ waySuffix way ++ ".a" -- e.g., _p.a
231 else do
232 extension <- setting DynamicExtension -- e.g., .dll or .so
233 version <- setting ProjectVersion -- e.g., 7.11.20141222
234 let prefix = wayPrefix $ removeWayUnit Dynamic way
235 -- e.g., p_ghc7.11.20141222.dll (the result)
236 return $ prefix ++ "-ghc" ++ version ++ extension