1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
module Rules.Gmp (
gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH
) where
import Base
import Context
import Oracles.Setting
import Packages
import Target
import Utilities
-- | Build GMP library objects and return their paths.
gmpObjects :: Action [FilePath]
gmpObjects = do
gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibraryH]
-- We need to use the untracked version of 'getDirectoryFiles', because the
-- contents of 'gmpObjectsDir' is built by Hadrian (in 'gmpRules'). Using
-- the tracked version can lead to Shake Lint failure.
-- See: https://ghc.haskell.org/trac/ghc/ticket/15971.
map unifyPath <$>
liftIO (getDirectoryFilesIO "" [gmpPath -/- gmpObjectsDir -/- "*.o"])
gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp"
gmpLibraryInTreeH :: FilePath
gmpLibraryInTreeH = "include/gmp.h"
gmpLibrary :: FilePath
gmpLibrary = ".libs/libgmp.a"
-- | GMP is considered a Stage1 package. This determines GMP build directory.
gmpContext :: Context
gmpContext = vanillaContext Stage1 integerGmp
-- TODO: Location of 'gmpBuildPath' is important: it should be outside any
-- package build directory, as otherwise GMP's object files will match build
-- patterns of 'compilePackage' rules. We could make 'compilePackage' rules
-- more precise to avoid such spurious matching.
-- | Build directory for in-tree GMP library.
gmpBuildPath :: Action FilePath
gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
-- | GMP library header, relative to 'gmpBuildPath'.
gmpLibraryH :: FilePath
gmpLibraryH = "include/ghc-gmp.h"
-- | Directory for GMP library object files, relative to 'gmpBuildPath'.
gmpObjectsDir :: FilePath
gmpObjectsDir = "objs"
configureEnvironment :: Action [CmdOption]
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
, builderEnvironment "AR" (Ar Unpack Stage1)
, builderEnvironment "NM" Nm ]
gmpRules :: Rules ()
gmpRules = do
-- Copy appropriate GMP header and object files
root <- buildRootRules
root <//> gmpLibraryH %> \header -> do
windows <- windowsHost
configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
if not windows && -- TODO: We don't use system GMP on Windows. Fix?
any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
then do
putBuild "| GMP library/framework detected and will be used"
copyFile (gmpBase -/- "ghc-gmp.h") header
else do
putBuild "| No GMP library/framework detected; in tree GMP will be built"
gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibrary]
createDirectory (gmpPath -/- gmpObjectsDir)
top <- topDirectory
build $ target gmpContext (Ar Unpack Stage1)
[top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
copyFile (gmpPath -/- "gmp.h") header
copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
-- Build in-tree GMP library, prioritised so that it matches "before"
-- the generic .a library rule in Rules.Library, whenever applicable.
priority 2.0 $ root <//> gmpLibrary %> \lib -> do
gmpPath <- gmpBuildPath
build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
putSuccess "| Successfully built custom library 'gmp'"
-- In-tree GMP header is built by the gmpLibraryH rule
root <//> gmpLibraryInTreeH %> \_ -> do
gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibraryH]
-- This causes integerGmp package to be configured, hence creating the files
root <//> "gmp/config.mk" %> \_ -> do
-- Calling 'need' on @setup-config@ triggers 'configurePackage'.
-- TODO: Shall we run 'configurePackage' directly? Why this indirection?
setupConfig <- pkgSetupConfigFile gmpContext
need [setupConfig]
-- TODO: Get rid of hard-coded @gmp@.
-- Run GMP's configure script
root <//> "gmp/Makefile" %> \mk -> do
env <- configureEnvironment
gmpPath <- gmpBuildPath
need [mk <.> "in"]
buildWithCmdOptions env $
target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
-- Extract in-tree GMP sources and apply patches
root <//> "gmp/Makefile.in" %> \_ -> do
gmpPath <- gmpBuildPath
removeDirectory gmpPath
-- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
-- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
-- That's because the doc/ directory contents are under the GFDL,
-- which causes problems for Debian.
tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
<$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
withTempDir $ \dir -> do
let tmp = unifyPath dir
need [tarball]
build $ target gmpContext (Tar Extract) [tarball] [tmp]
let patch = gmpBase -/- "gmpsrc.patch"
patchName = takeFileName patch
copyFile patch $ tmp -/- patchName
applyPatch tmp patchName
let name = dropExtension . dropExtension $ takeFileName tarball
unpack = fromMaybe . error $ "gmpRules: expected suffix "
++ "-nodoc (found: " ++ name ++ ")."
libName = unpack $ stripSuffix "-nodoc" name
moveDirectory (tmp -/- libName) gmpPath
|
