1 module Rules
.Generate
(
2 isGeneratedCmmFile
, compilerDependencies
, generatePackageCode
,
3 generateRules
, copyRules
, generatedDependencies
, generatedGhcDependencies
,
10 import Hadrian
.Oracles
.TextFile
(lookupValueOrError
)
12 import Oracles
.ModuleFiles
13 import Oracles
.Setting
21 -- | Track this file to rebuild generated files whenever it changes.
22 trackGenerateHs
:: Expr
()
23 trackGenerateHs
= expr
$ need
[sourcePath
-/- "Rules/Generate.hs"]
25 primopsSource
:: FilePath
26 primopsSource
= "compiler/prelude/primops.txt.pp"
28 primopsTxt
:: Stage
-> FilePath
29 primopsTxt stage
= buildDir
(vanillaContext stage compiler
) -/- "primops.txt"
31 isGeneratedCmmFile
:: FilePath -> Bool
32 isGeneratedCmmFile file
= takeBaseName file
== "AutoApply"
34 ghcPrimDependencies
:: Expr
[FilePath]
35 ghcPrimDependencies
= do
37 path
<- expr
$ buildPath
(vanillaContext stage ghcPrim
)
38 return [path
-/- "GHC/Prim.hs", path
-/- "GHC/PrimopWrappers.hs"]
40 derivedConstantsDependencies
:: [FilePath]
41 derivedConstantsDependencies
= fmap (generatedDir
-/-)
42 [ "DerivedConstants.h"
43 , "GHCConstantsHaskellExports.hs"
44 , "GHCConstantsHaskellType.hs"
45 , "GHCConstantsHaskellWrappers.hs" ]
47 compilerDependencies
:: Expr
[FilePath]
48 compilerDependencies
= do
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" ] ]
75 generatedDependencies
:: Expr
[FilePath]
76 generatedDependencies
= do
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
85 ++ fmap (root
-/-) derivedConstantsDependencies
)
86 , stage0 ?
return includes
]
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
++ "."
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
104 build
$ target context builder
[src
] [file
]
105 let boot
= src
-<.> "hs-boot"
106 whenM
(doesFileExist boot
) $ do
107 let target
= file
-<.> "hs-boot"
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
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
]
127 root
-/- stageString stage
<//> "ghc_boot_platform.h" %>
128 go generateGhcBootPlatformH
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
))
139 pattern
<~ mdir
= pattern
%> \file
-> do
141 copyFile
(dir
-/- takeFileName file
) file
143 genPrimopCode
:: Context
-> FilePath -> Action
()
144 genPrimopCode context
@(Context stage _pkg _
) file
= do
146 need
[root
-/- primopsTxt stage
]
147 build
$ target context GenPrimopCode
[root
-/- primopsTxt stage
] [file
]
149 copyRules
:: Rules
()
151 root
<- buildRootRules
152 forM_
[Stage0
..] $ \stage
-> do
153 let prefix
= root
-/- stageString stage
-/- "lib"
156 pattern
<~ mdir
= pattern
%> \file
-> do
158 copyFile
(dir
-/- makeRelative prefix file
) file
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
)
167 prefix
-/- "html//*" <~
return "utils/haddock/haddock-api/resources"
168 prefix
-/- "latex//*" <~
return "utils/haddock/haddock-api/resources"
170 generateRules
:: Rules
()
172 root
<- buildRootRules
174 (root
-/- "ghc-stage1") <~ ghcWrapper Stage1
175 (root
-/- "ghc-stage2") <~ ghcWrapper Stage2
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
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
]
190 file
<~ gen
= file
%> \out
-> generate out emptyTarget gen
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")
199 emptyTarget
:: Context
200 emptyTarget
= vanillaContext
(error "Rules.Generate.emptyTarget: unknown stage")
201 (error "Rules.Generate.emptyTarget: unknown package")
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
]
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
'.' '_
'
221 -- | Generate @ghcplatform.h@ header.
222 generateGhcPlatformH
:: Expr
String
223 generateGhcPlatformH
= do
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
235 [ "#ifndef __GHCPLATFORM_H__"
236 , "#define __GHCPLATFORM_H__"
238 , "#define BuildPlatform_TYPE " ++ cppify hostPlatform
239 , "#define HostPlatform_TYPE " ++ cppify targetPlatform
241 , "#define " ++ cppify hostPlatform
++ "_BUILD 1"
242 , "#define " ++ cppify targetPlatform
++ "_HOST 1"
244 , "#define " ++ hostArch
++ "_BUILD_ARCH 1"
245 , "#define " ++ targetArch
++ "_HOST_ARCH 1"
246 , "#define BUILD_ARCH " ++ show hostArch
247 , "#define HOST_ARCH " ++ show targetArch
249 , "#define " ++ hostOs
++ "_BUILD_OS 1"
250 , "#define " ++ targetOs
++ "_HOST_OS 1"
251 , "#define BUILD_OS " ++ show hostOs
252 , "#define HOST_OS " ++ show targetOs
254 , "#define " ++ hostVendor
++ "_BUILD_VENDOR 1"
255 , "#define " ++ targetVendor
++ "_HOST_VENDOR 1"
256 , "#define BUILD_VENDOR " ++ show hostVendor
257 , "#define HOST_VENDOR " ++ show targetVendor
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" ]
268 [ "#define UnregisterisedCompiler 1" | ghcUnreg
]
270 [ "\n#endif /* __GHCPLATFORM_H__ */" ]
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
)
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
)
323 let showTuple
(k
, v
) = "(" ++ show k
++ ", " ++ show v
++ ")"
324 pure
$ case settings
of
328 : ((\s
' -> "," ++ showTuple s
') <$> ss
)
332 -- | Generate @Config.hs@ files.
333 generateConfigHs
:: Expr
String
334 generateConfigHs
= do
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
345 [ "{-# LANGUAGE CPP #-}"
346 , "module Config where"
348 , "import GhcPrelude"
350 , "#include \"ghc_boot_platform.h\""
352 , "cBuildPlatformString :: String"
353 , "cBuildPlatformString = BuildPlatform_NAME"
354 , "cHostPlatformString :: String"
355 , "cHostPlatformString = HostPlatform_NAME"
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
374 , "cStage = show (STAGE :: Int)"
377 -- | Generate @ghcautoconf.h@ header.
378 generateGhcAutoconfH
:: Expr
String
379 generateGhcAutoconfH
= do
381 configHContents
<- expr
$ map undefinePackage
<$> readFileLines configH
382 tablesNextToCode
<- expr ghcEnableTablesNextToCode
383 ghcUnreg
<- getFlag GhcUnregisterised
384 ccLlvmBackend
<- getSetting CcLlvmBackend
385 ccClangBackend
<- getSetting CcClangBackend
387 [ "#ifndef __GHCAUTOCONF_H__"
388 , "#define __GHCAUTOCONF_H__" ]
389 ++ configHContents
++
390 [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode
&& not ghcUnreg
]
392 [ "\n#define llvm_CC_FLAVOR 1" | ccLlvmBackend
== "1" ]
394 [ "\n#define clang_CC_FLAVOR 1" | ccClangBackend
== "1" ]
396 [ "#endif /* __GHCAUTOCONF_H__ */" ]
399 |
"#define PACKAGE_" `
isPrefixOf` s
400 = "/* #undef " ++ takeWhile (/=' ') (drop 8 s
) ++ " */"
403 -- | Generate @ghc_boot_platform.h@ headers.
404 generateGhcBootPlatformH
:: Expr
String
405 generateGhcBootPlatformH
= do
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
423 [ "#ifndef __PLATFORM_H__"
424 , "#define __PLATFORM_H__"
426 , "#define BuildPlatform_NAME " ++ show buildPlatform
427 , "#define HostPlatform_NAME " ++ show hostPlatform
429 , "#define " ++ cppify buildPlatform
++ "_BUILD 1"
430 , "#define " ++ cppify hostPlatform
++ "_HOST 1"
431 , "#define " ++ cppify targetPlatform
++ "_TARGET 1"
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
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
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
455 , "#endif /* __PLATFORM_H__ */" ]
457 -- | Generate @ghcversion.h@ header.
458 generateGhcVersionH
:: Expr
String
459 generateGhcVersionH
= do
461 version
<- getSetting ProjectVersionInt
462 patchLevel1
<- getSetting ProjectPatchLevel1
463 patchLevel2
<- getSetting ProjectPatchLevel2
465 [ "#ifndef __GHCVERSION_H__"
466 , "#define __GHCVERSION_H__"
468 , "#ifndef __GLASGOW_HASKELL__"
469 , "# define __GLASGOW_HASKELL__ " ++ version
473 [ "#define __GLASGOW_HASKELL_PATCHLEVEL1__ " ++ patchLevel1 | patchLevel1
/= "" ]
475 [ "#define __GLASGOW_HASKELL_PATCHLEVEL2__ " ++ patchLevel2 | patchLevel2
/= "" ]
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__ )"
486 , "#endif /* __GHCVERSION_H__ */" ]
488 -- | Generate @Version.hs@ files.
489 generateVersionHs
:: Expr
String
490 generateVersionHs
= do
492 projectVersion
<- getSetting ProjectVersion
493 targetOs
<- getSetting TargetOs
494 targetArch
<- getSetting TargetArch
496 [ "module Version where"
497 , "version, targetOS, targetARCH :: String"
498 , "version = " ++ show projectVersion
499 , "targetOS = " ++ show targetOs
500 , "targetARCH = " ++ show targetArch
]