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