Hadrian: Fix problem with unlit path in settings file
[ghc.git] / hadrian / src / Rules / Generate.hs
1 module Rules.Generate (
2 isGeneratedCmmFile, compilerDependencies, generatePackageCode,
3 generateRules, copyRules, generatedDependencies, generatedGhcDependencies,
4 ghcPrimDependencies
5 ) where
6
7 import Base
8 import qualified Context
9 import Expression
10 import Flavour
11 import Hadrian.Oracles.TextFile (lookupValueOrError)
12 import Oracles.Flag
13 import Oracles.ModuleFiles
14 import Oracles.Setting
15 import Packages
16 import Rules.Gmp
17 import Rules.Libffi
18 import Settings
19 import Target
20 import Utilities
21
22 -- | Track this file to rebuild generated files whenever it changes.
23 trackGenerateHs :: Expr ()
24 trackGenerateHs = expr $ need [sourcePath -/- "Rules/Generate.hs"]
25
26 primopsSource :: FilePath
27 primopsSource = "compiler/prelude/primops.txt.pp"
28
29 primopsTxt :: Stage -> FilePath
30 primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt"
31
32 isGeneratedCmmFile :: FilePath -> Bool
33 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
34
35 ghcPrimDependencies :: Expr [FilePath]
36 ghcPrimDependencies = do
37 stage <- getStage
38 path <- expr $ buildPath (vanillaContext stage ghcPrim)
39 return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
40
41 derivedConstantsDependencies :: [FilePath]
42 derivedConstantsDependencies = fmap (generatedDir -/-)
43 [ "DerivedConstants.h"
44 , "GHCConstantsHaskellExports.hs"
45 , "GHCConstantsHaskellType.hs"
46 , "GHCConstantsHaskellWrappers.hs" ]
47
48 compilerDependencies :: Expr [FilePath]
49 compilerDependencies = do
50 root <- getBuildRoot
51 stage <- getStage
52 isGmp <- (== integerGmp) <$> getIntegerPackage
53 ghcPath <- expr $ buildPath (vanillaContext stage compiler)
54 gmpPath <- expr gmpBuildPath
55 rtsPath <- expr (rtsBuildPath stage)
56 mconcat [ return ((root -/-) <$> derivedConstantsDependencies)
57 , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
58 , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles)
59 , return $ fmap (ghcPath -/-)
60 [ "primop-can-fail.hs-incl"
61 , "primop-code-size.hs-incl"
62 , "primop-commutable.hs-incl"
63 , "primop-data-decl.hs-incl"
64 , "primop-fixity.hs-incl"
65 , "primop-has-side-effects.hs-incl"
66 , "primop-list.hs-incl"
67 , "primop-out-of-line.hs-incl"
68 , "primop-primop-info.hs-incl"
69 , "primop-strictness.hs-incl"
70 , "primop-tag.hs-incl"
71 , "primop-vector-tycons.hs-incl"
72 , "primop-vector-tys-exports.hs-incl"
73 , "primop-vector-tys.hs-incl"
74 , "primop-vector-uniques.hs-incl" ] ]
75
76 generatedDependencies :: Expr [FilePath]
77 generatedDependencies = do
78 root <- getBuildRoot
79 stage <- getStage
80 rtsPath <- expr (rtsBuildPath stage)
81 includes <- expr includesDependencies
82 mconcat [ package compiler ? compilerDependencies
83 , package ghcPrim ? ghcPrimDependencies
84 , package rts ? return (fmap (rtsPath -/-) libffiHeaderFiles
85 ++ includes
86 ++ fmap (root -/-) derivedConstantsDependencies)
87 , stage0 ? return includes ]
88
89 generate :: FilePath -> Context -> Expr String -> Action ()
90 generate file context expr = do
91 contents <- interpretInContext context expr
92 writeFileChanged file contents
93 putSuccess $ "| Successfully generated " ++ file ++ "."
94
95 generatePackageCode :: Context -> Rules ()
96 generatePackageCode context@(Context stage pkg _) = do
97 root <- buildRootRules
98 let dir = buildDir context
99 generated f = (root -/- dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
100 go gen file = generate file context gen
101 generated ?> \file -> do
102 let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
103 (src, builder) <- unpack <$> findGenerator context file
104 need [src]
105 build $ target context builder [src] [file]
106 let boot = src -<.> "hs-boot"
107 whenM (doesFileExist boot) $ do
108 let target = file -<.> "hs-boot"
109 copyFile boot target
110 produces [target]
111
112 priority 2.0 $ do
113 when (pkg == compiler) $ do
114 root <//> dir -/- "Config.hs" %> go generateConfigHs
115 root <//> dir -/- "*.hs-incl" %> genPrimopCode context
116 when (pkg == ghcPrim) $ do
117 root <//> dir -/- "GHC/Prim.hs" %> genPrimopCode context
118 root <//> dir -/- "GHC/PrimopWrappers.hs" %> genPrimopCode context
119 when (pkg == ghcPkg) $
120 root <//> dir -/- "Version.hs" %> go generateVersionHs
121
122 when (pkg == compiler) $ do
123 root -/- primopsTxt stage %> \file -> do
124 includes <- includesDependencies
125 need $ [primopsSource] ++ includes
126 build $ target context HsCpp [primopsSource] [file]
127
128 root -/- stageString stage <//> "ghc_boot_platform.h" %>
129 go generateGhcBootPlatformH
130
131 when (pkg == rts) $ do
132 root <//> dir -/- "cmm/AutoApply.cmm" %> \file ->
133 build $ target context GenApply [] [file]
134 -- TODO: This should be fixed properly, e.g. generated here on demand.
135 (root <//> dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir))
136 (root <//> dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir))
137 (root <//> dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir))
138 (root <//> dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir))
139 where
140 pattern <~ mdir = pattern %> \file -> do
141 dir <- mdir
142 copyFile (dir -/- takeFileName file) file
143
144 genPrimopCode :: Context -> FilePath -> Action ()
145 genPrimopCode context@(Context stage _pkg _) file = do
146 root <- buildRoot
147 need [root -/- primopsTxt stage]
148 build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
149
150 copyRules :: Rules ()
151 copyRules = do
152 root <- buildRootRules
153 forM_ [Stage0 ..] $ \stage -> do
154 let prefix = root -/- stageString stage -/- "lib"
155
156 infixl 1 <~
157 pattern <~ mdir = pattern %> \file -> do
158 dir <- mdir
159 copyFile (dir -/- makeRelative prefix file) file
160
161 prefix -/- "ghc-usage.txt" <~ return "driver"
162 prefix -/- "ghci-usage.txt" <~ return "driver"
163 prefix -/- "llvm-targets" <~ return "."
164 prefix -/- "llvm-passes" <~ return "."
165 prefix -/- "platformConstants" <~ (buildRoot <&> (-/- generatedDir))
166 prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs)
167
168 prefix -/- "html//*" <~ return "utils/haddock/haddock-api/resources"
169 prefix -/- "latex//*" <~ return "utils/haddock/haddock-api/resources"
170
171 generateRules :: Rules ()
172 generateRules = do
173 root <- buildRootRules
174
175 (root -/- "ghc-stage1") <~ ghcWrapper Stage1
176 (root -/- "ghc-stage2") <~ ghcWrapper Stage2
177
178 priority 2.0 $ (root -/- generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH
179 priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH
180 priority 2.0 $ (root -/- generatedDir -/- "ghcversion.h") <~ generateGhcVersionH
181 forM_ [Stage0 ..] $ \stage -> do
182 let prefix = root -/- stageString stage -/- "lib"
183 go gen file = generate file (semiEmptyTarget stage) gen
184 priority 2.0 $ (prefix -/- "settings") %> go generateSettings
185
186 -- TODO: simplify, get rid of fake rts context
187 root -/- generatedDir ++ "//*" %> \file -> do
188 withTempDir $ \dir -> build $
189 target (rtsContext Stage1) DeriveConstants [] [file, dir]
190 where
191 file <~ gen = file %> \out -> generate out emptyTarget gen
192
193 -- TODO: Use the Types, Luke! (drop partial function)
194 -- We sometimes need to evaluate expressions that do not require knowing all
195 -- information about the context. In this case, we don't want to know anything.
196 semiEmptyTarget :: Stage -> Context
197 semiEmptyTarget stage = vanillaContext stage
198 (error "Rules.Generate.emptyTarget: unknown package")
199
200 emptyTarget :: Context
201 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
202 (error "Rules.Generate.emptyTarget: unknown package")
203
204 -- Generators
205
206 -- | GHC wrapper scripts used for passing the path to the right package database
207 -- when invoking in-tree GHC executables.
208 ghcWrapper :: Stage -> Expr String
209 ghcWrapper Stage0 = error "Stage0 GHC does not require a wrapper script to run."
210 ghcWrapper stage = do
211 dbPath <- expr $ packageDbPath stage
212 ghcPath <- expr $ programPath (vanillaContext (pred stage) ghc)
213 return $ unwords $ map show $ [ ghcPath ]
214 ++ [ "-package-db " ++ dbPath | stage == Stage1 ]
215 ++ [ "$@" ]
216
217 -- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
218 -- the resulting 'String' is a valid C preprocessor identifier.
219 cppify :: String -> String
220 cppify = replaceEq '-' '_' . replaceEq '.' '_'
221
222 -- | Generate @ghcplatform.h@ header.
223 generateGhcPlatformH :: Expr String
224 generateGhcPlatformH = do
225 trackGenerateHs
226 hostPlatform <- getSetting HostPlatform
227 hostArch <- getSetting HostArch
228 hostOs <- getSetting HostOs
229 hostVendor <- getSetting HostVendor
230 targetPlatform <- getSetting TargetPlatform
231 targetArch <- getSetting TargetArch
232 targetOs <- getSetting TargetOs
233 targetVendor <- getSetting TargetVendor
234 ghcUnreg <- getFlag GhcUnregisterised
235 return . unlines $
236 [ "#ifndef __GHCPLATFORM_H__"
237 , "#define __GHCPLATFORM_H__"
238 , ""
239 , "#define BuildPlatform_TYPE " ++ cppify hostPlatform
240 , "#define HostPlatform_TYPE " ++ cppify targetPlatform
241 , ""
242 , "#define " ++ cppify hostPlatform ++ "_BUILD 1"
243 , "#define " ++ cppify targetPlatform ++ "_HOST 1"
244 , ""
245 , "#define " ++ hostArch ++ "_BUILD_ARCH 1"
246 , "#define " ++ targetArch ++ "_HOST_ARCH 1"
247 , "#define BUILD_ARCH " ++ show hostArch
248 , "#define HOST_ARCH " ++ show targetArch
249 , ""
250 , "#define " ++ hostOs ++ "_BUILD_OS 1"
251 , "#define " ++ targetOs ++ "_HOST_OS 1"
252 , "#define BUILD_OS " ++ show hostOs
253 , "#define HOST_OS " ++ show targetOs
254 , ""
255 , "#define " ++ hostVendor ++ "_BUILD_VENDOR 1"
256 , "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
257 , "#define BUILD_VENDOR " ++ show hostVendor
258 , "#define HOST_VENDOR " ++ show targetVendor
259 , ""
260 , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
261 , "#define TargetPlatform_TYPE " ++ cppify targetPlatform
262 , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
263 , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
264 , "#define TARGET_ARCH " ++ show targetArch
265 , "#define " ++ targetOs ++ "_TARGET_OS 1"
266 , "#define TARGET_OS " ++ show targetOs
267 , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
268 ++
269 [ "#define UnregisterisedCompiler 1" | ghcUnreg ]
270 ++
271 [ "\n#endif /* __GHCPLATFORM_H__ */" ]
272
273 generateSettings :: Expr String
274 generateSettings = do
275 ctx <- getContext
276 settings <- traverse sequence $
277 [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts")
278 , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand)
279 , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags)
280 , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags)
281 , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie)
282 , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand)
283 , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
284 , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand)
285 , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags)
286 , ("ld supports compact unwind", expr $ lookupValueOrError configFile "ld-has-no-compact-unwind")
287 , ("ld supports build-id", expr $ lookupValueOrError configFile "ld-has-build-id")
288 , ("ld supports filelist", expr $ lookupValueOrError configFile "ld-has-filelist")
289 , ("ld is GNU ld", expr $ lookupValueOrError configFile "ld-is-gnu-ld")
290 , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand)
291 , ("ar flags", expr $ lookupValueOrError configFile "ar-args")
292 , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile)
293 , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand)
294 , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand)
295 , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand)
296 , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand)
297 , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand)
298 , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
299 , ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
300 , ("target platform string", getSetting TargetPlatform)
301 , ("target os", expr $ lookupValueOrError configFile "haskell-target-os")
302 , ("target arch", expr $ lookupValueOrError configFile "haskell-target-arch")
303 , ("target word size", expr $ lookupValueOrError configFile "target-word-size")
304 , ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "haskell-have-gnu-nonexec-stack")
305 , ("target has .ident directive", expr $ lookupValueOrError configFile "haskell-have-ident-directive")
306 , ("target has subsections via symbols", expr $ lookupValueOrError configFile "haskell-have-subsections-via-symbols")
307 , ("target has RTS linker", expr $ lookupValueOrError configFile "haskell-have-rts-linker")
308 , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised)
309 , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand)
310 , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand)
311 , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand)
312
313 , ("integer library", pkgName <$> getIntegerPackage)
314 , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
315 , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen)
316 , ("Support SMP", expr $ yesNo <$> ghcWithSMP)
317 , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore)
318 , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode)
319 , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors)
320 , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors)
321 , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays)
322 , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour)
323 , ("RTS expects libdw", yesNo <$> getFlag WithLibdw)
324 ]
325 let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
326 pure $ case settings of
327 [] -> "[]"
328 s : ss -> unlines $
329 ("[" ++ showTuple s)
330 : ((\s' -> "," ++ showTuple s') <$> ss)
331 ++ ["]"]
332
333
334 -- | Generate @Config.hs@ files.
335 generateConfigHs :: Expr String
336 generateConfigHs = do
337 trackGenerateHs
338 cProjectName <- getSetting ProjectName
339 cProjectGitCommitId <- getSetting ProjectGitCommitId
340 cProjectVersion <- getSetting ProjectVersion
341 cProjectVersionInt <- getSetting ProjectVersionInt
342 cProjectPatchLevel <- getSetting ProjectPatchLevel
343 cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
344 cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
345 cBooterVersion <- getSetting GhcVersion
346 return $ unlines
347 [ "{-# LANGUAGE CPP #-}"
348 , "module Config where"
349 , ""
350 , "import GhcPrelude"
351 , ""
352 , "#include \"ghc_boot_platform.h\""
353 , ""
354 , "cBuildPlatformString :: String"
355 , "cBuildPlatformString = BuildPlatform_NAME"
356 , "cHostPlatformString :: String"
357 , "cHostPlatformString = HostPlatform_NAME"
358 , ""
359 , "cProjectName :: String"
360 , "cProjectName = " ++ show cProjectName
361 , "cProjectGitCommitId :: String"
362 , "cProjectGitCommitId = " ++ show cProjectGitCommitId
363 , "cProjectVersion :: String"
364 , "cProjectVersion = " ++ show cProjectVersion
365 , "cProjectVersionInt :: String"
366 , "cProjectVersionInt = " ++ show cProjectVersionInt
367 , "cProjectPatchLevel :: String"
368 , "cProjectPatchLevel = " ++ show cProjectPatchLevel
369 , "cProjectPatchLevel1 :: String"
370 , "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
371 , "cProjectPatchLevel2 :: String"
372 , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
373 , "cBooterVersion :: String"
374 , "cBooterVersion = " ++ show cBooterVersion
375 , "cStage :: String"
376 , "cStage = show (STAGE :: Int)"
377 ]
378
379 -- | Generate @ghcautoconf.h@ header.
380 generateGhcAutoconfH :: Expr String
381 generateGhcAutoconfH = do
382 trackGenerateHs
383 configHContents <- expr $ map undefinePackage <$> readFileLines configH
384 tablesNextToCode <- expr ghcEnableTablesNextToCode
385 ghcUnreg <- getFlag GhcUnregisterised
386 ccLlvmBackend <- getSetting CcLlvmBackend
387 ccClangBackend <- getSetting CcClangBackend
388 return . unlines $
389 [ "#ifndef __GHCAUTOCONF_H__"
390 , "#define __GHCAUTOCONF_H__" ]
391 ++ configHContents ++
392 [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ]
393 ++
394 [ "\n#define llvm_CC_FLAVOR 1" | ccLlvmBackend == "1" ]
395 ++
396 [ "\n#define clang_CC_FLAVOR 1" | ccClangBackend == "1" ]
397 ++
398 [ "#endif /* __GHCAUTOCONF_H__ */" ]
399 where
400 undefinePackage s
401 | "#define PACKAGE_" `isPrefixOf` s
402 = "/* #undef " ++ takeWhile (/=' ') (drop 8 s) ++ " */"
403 | otherwise = s
404
405 -- | Generate @ghc_boot_platform.h@ headers.
406 generateGhcBootPlatformH :: Expr String
407 generateGhcBootPlatformH = do
408 trackGenerateHs
409 stage <- getStage
410 let chooseSetting x y = getSetting $ if stage == Stage0 then x else y
411 buildPlatform <- chooseSetting BuildPlatform HostPlatform
412 buildArch <- chooseSetting BuildArch HostArch
413 buildOs <- chooseSetting BuildOs HostOs
414 buildVendor <- chooseSetting BuildVendor HostVendor
415 hostPlatform <- chooseSetting HostPlatform TargetPlatform
416 hostArch <- chooseSetting HostArch TargetArch
417 hostOs <- chooseSetting HostOs TargetOs
418 hostVendor <- chooseSetting HostVendor TargetVendor
419 targetPlatform <- getSetting TargetPlatform
420 targetArch <- getSetting TargetArch
421 llvmTarget <- getSetting LlvmTarget
422 targetOs <- getSetting TargetOs
423 targetVendor <- getSetting TargetVendor
424 return $ unlines
425 [ "#ifndef __PLATFORM_H__"
426 , "#define __PLATFORM_H__"
427 , ""
428 , "#define BuildPlatform_NAME " ++ show buildPlatform
429 , "#define HostPlatform_NAME " ++ show hostPlatform
430 , ""
431 , "#define " ++ cppify buildPlatform ++ "_BUILD 1"
432 , "#define " ++ cppify hostPlatform ++ "_HOST 1"
433 , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
434 , ""
435 , "#define " ++ buildArch ++ "_BUILD_ARCH 1"
436 , "#define " ++ hostArch ++ "_HOST_ARCH 1"
437 , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
438 , "#define BUILD_ARCH " ++ show buildArch
439 , "#define HOST_ARCH " ++ show hostArch
440 , "#define TARGET_ARCH " ++ show targetArch
441 , "#define LLVM_TARGET " ++ show llvmTarget
442 , ""
443 , "#define " ++ buildOs ++ "_BUILD_OS 1"
444 , "#define " ++ hostOs ++ "_HOST_OS 1"
445 , "#define " ++ targetOs ++ "_TARGET_OS 1"
446 , "#define BUILD_OS " ++ show buildOs
447 , "#define HOST_OS " ++ show hostOs
448 , "#define TARGET_OS " ++ show targetOs
449 , ""
450 , "#define " ++ buildVendor ++ "_BUILD_VENDOR 1"
451 , "#define " ++ hostVendor ++ "_HOST_VENDOR 1"
452 , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1"
453 , "#define BUILD_VENDOR " ++ show buildVendor
454 , "#define HOST_VENDOR " ++ show hostVendor
455 , "#define TARGET_VENDOR " ++ show targetVendor
456 , ""
457 , "#endif /* __PLATFORM_H__ */" ]
458
459 -- | Generate @ghcversion.h@ header.
460 generateGhcVersionH :: Expr String
461 generateGhcVersionH = do
462 trackGenerateHs
463 version <- getSetting ProjectVersionInt
464 patchLevel1 <- getSetting ProjectPatchLevel1
465 patchLevel2 <- getSetting ProjectPatchLevel2
466 return . unlines $
467 [ "#ifndef __GHCVERSION_H__"
468 , "#define __GHCVERSION_H__"
469 , ""
470 , "#ifndef __GLASGOW_HASKELL__"
471 , "# define __GLASGOW_HASKELL__ " ++ version
472 , "#endif"
473 , ""]
474 ++
475 [ "#define __GLASGOW_HASKELL_PATCHLEVEL1__ " ++ patchLevel1 | patchLevel1 /= "" ]
476 ++
477 [ "#define __GLASGOW_HASKELL_PATCHLEVEL2__ " ++ patchLevel2 | patchLevel2 /= "" ]
478 ++
479 [ ""
480 , "#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\\"
481 , " ((ma)*100+(mi)) < __GLASGOW_HASKELL__ || \\"
482 , " ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \\"
483 , " && (pl1) < __GLASGOW_HASKELL_PATCHLEVEL1__ || \\"
484 , " ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \\"
485 , " && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \\"
486 , " && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )"
487 , ""
488 , "#endif /* __GHCVERSION_H__ */" ]
489
490 -- | Generate @Version.hs@ files.
491 generateVersionHs :: Expr String
492 generateVersionHs = do
493 trackGenerateHs
494 projectVersion <- getSetting ProjectVersion
495 targetOs <- getSetting TargetOs
496 targetArch <- getSetting TargetArch
497 return $ unlines
498 [ "module Version where"
499 , "version, targetOS, targetARCH :: String"
500 , "version = " ++ show projectVersion
501 , "targetOS = " ++ show targetOs
502 , "targetARCH = " ++ show targetArch ]