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
|
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]
-- The line below causes a Shake Lint failure on Windows, which forced us to
-- disable Lint by default. See more details here:
-- https://gitlab.haskell.org/ghc/ghc/issues/15971.
map (unifyPath . (gmpPath -/-)) <$>
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")
-- | Like 'gmpBuildPath' but in the 'Rules' monad.
gmpBuildPathRules :: Rules FilePath
gmpBuildPathRules = buildRootRules <&> (-/- 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
gmpPath <- gmpBuildPathRules
gmpPath -/- gmpLibraryH %> \header -> do
configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
if not windowsHost && -- 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"
need [gmpPath -/- gmpLibrary]
createDirectory (gmpPath -/- gmpObjectsDir)
top <- topDirectory
build $ target gmpContext (Ar Unpack Stage1)
[top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
objs <- liftIO $ getDirectoryFilesIO "." [gmpPath -/- gmpObjectsDir -/- "*"]
produces objs
copyFileUntracked (gmpPath -/- "gmp.h") header
-- Build in-tree GMP library, prioritised so that it matches "before"
-- the generic @.a@ library rule in 'Rules.Library'.
priority 2.0 $ gmpPath -/- gmpLibrary %> \lib -> do
build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
putSuccess "| Successfully built custom library 'gmp'"
gmpPath -/- gmpLibraryInTreeH %> copyFile (gmpPath -/- gmpLibraryH)
root <- buildRootRules
root -/- buildDir gmpContext -/- gmpLibraryH %>
copyFile (gmpPath -/- gmpLibraryH)
-- This file is created when 'integerGmp' is configured.
gmpPath -/- "config.mk" %> \_ -> ensureConfigured gmpContext
-- Run GMP's configure script
gmpPath -/- "Makefile" %> \mk -> do
env <- configureEnvironment
need [mk <.> "in"]
buildWithCmdOptions env $
target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
-- Extract in-tree GMP sources and apply patches
fmap (gmpPath -/-) ["Makefile.in", "configure"] &%> \_ -> do
top <- topDirectory
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 top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
withTempDir $ \dir -> do
let tmp = unifyPath dir
need [top -/- tarball]
build $ target gmpContext (Tar Extract) [top -/- 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
|