[commit: ghc] wip/nfs-locking: Refactor GMP build rule (6836711)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:22:41 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/68367119d7f5d1f01a94a0eab87a53900c54fe3e/ghc
>---------------------------------------------------------------
commit 68367119d7f5d1f01a94a0eab87a53900c54fe3e
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sun Oct 2 10:40:16 2016 +0900
Refactor GMP build rule
See #289.
>---------------------------------------------------------------
68367119d7f5d1f01a94a0eab87a53900c54fe3e
src/Rules/Gmp.hs | 92 ++++++++++++++++++++++++---------------------------
src/Settings/Paths.hs | 8 ++---
2 files changed, 45 insertions(+), 55 deletions(-)
diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs
index 7fc3e18..66d6c0b 100644
--- a/src/Rules/Gmp.hs
+++ b/src/Rules/Gmp.hs
@@ -17,10 +17,12 @@ gmpBase = pkgPath integerGmp -/- "gmp"
gmpContext :: Context
gmpContext = vanillaContext Stage1 integerGmp
--- TODO: Noone needs this file, but we build it. Why?
gmpLibraryInTreeH :: FilePath
gmpLibraryInTreeH = gmpBuildPath -/- "include/gmp.h"
+gmpLibrary :: FilePath
+gmpLibrary = gmpBuildPath -/- ".libs/libgmp.a"
+
gmpPatches :: [FilePath]
gmpPatches = (gmpBase -/-) <$> ["gmpsrc.patch", "tarball/gmp-5.0.4.patch"]
@@ -29,76 +31,68 @@ configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
, builderEnvironment "AR" Ar
, builderEnvironment "NM" Nm ]
--- TODO: we rebuild gmp every time.
gmpRules :: Rules ()
gmpRules = do
- -- TODO: split into multiple rules
gmpLibraryH %> \_ -> do
- need [sourcePath -/- "Rules/Gmp.hs"]
- removeDirectory gmpBuildPath
-
- -- We don't use system GMP on Windows. TODO: fix?
windows <- windowsHost
configMk <- readFile' $ gmpBase -/- "config.mk"
- if not windows && any (`isInfixOf` configMk)
- [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
+ 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"
createDirectory $ takeDirectory gmpLibraryH
copyFile (gmpBase -/- "ghc-gmp.h") gmpLibraryH
else do
putBuild "| No GMP library/framework detected; in tree GMP will be built"
-
- -- 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.
- tarballs <- getDirectoryFiles "" [gmpBase -/- "tarball/gmp*.tar.bz2"]
- tarball <- case tarballs of -- TODO: Drop code duplication.
- [file] -> return $ unifyPath file
- _ -> error $ "gmpRules: exactly one tarball expected"
- ++ "(found: " ++ show tarballs ++ ")."
-
- withTempDir $ \dir -> do
- let tmp = unifyPath dir
- need [tarball]
- build $ Target gmpContext Tar [tarball] [tmp]
-
- forM_ gmpPatches $ \src -> do
- let patch = takeFileName src
- patchPath = tmp -/- patch
- copyFile src patchPath
- applyPatch tmp patch
-
- let name = dropExtension . dropExtension $ takeFileName tarball
- unpack = fromMaybe . error $ "gmpRules: expected suffix "
- ++ "-nodoc-patched (found: " ++ name ++ ")."
- libName = unpack $ stripSuffix "-nodoc-patched" name
-
- moveDirectory (tmp -/- libName) gmpBuildPath
-
- env <- configureEnvironment
- buildWithCmdOptions env $
- Target gmpContext (Configure gmpBuildPath)
- [gmpBuildPath -/- "Makefile.in"]
- [gmpBuildPath -/- "Makefile"]
-
build $ Target gmpContext (Make gmpBuildPath) [] []
-
createDirectory $ takeDirectory gmpLibraryH
copyFile (gmpBuildPath -/- "gmp.h") gmpLibraryH
copyFile (gmpBuildPath -/- "gmp.h") gmpLibraryInTreeH
- moveFile (gmpBuildPath -/- ".libs/libgmp.a") gmpLibrary
-
createDirectory gmpObjects
build $ Target gmpContext Ar [gmpLibrary] [gmpObjects]
- runBuilder Ranlib [gmpLibrary]
-
putSuccess "| Successfully built custom library 'gmp'"
+ -- In-tree GMP header is built in the gmpLibraryH rule
gmpLibraryInTreeH %> \_ -> need [gmpLibraryH]
-- This causes integerGmp package to be configured, hence creating the files
[gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ ->
need [pkgDataFile gmpContext]
+
+ -- Extract in-tree GMP sources and apply patches
+ gmpBuildPath -/- "Makefile.in" %> \_ -> do
+ removeDirectory gmpBuildPath
+ -- 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.
+ tarballs <- getDirectoryFiles "" [gmpBase -/- "tarball/gmp*.tar.bz2"]
+ tarball <- case tarballs of -- TODO: Drop code duplication.
+ [file] -> return $ unifyPath file
+ _ -> error $ "gmpRules: exactly one tarball expected"
+ ++ "(found: " ++ show tarballs ++ ")."
+
+ withTempDir $ \dir -> do
+ let tmp = unifyPath dir
+ need [tarball]
+ build $ Target gmpContext Tar [tarball] [tmp]
+
+ forM_ gmpPatches $ \src -> do
+ let patch = takeFileName src
+ copyFile src $ tmp -/- patch
+ applyPatch tmp patch
+
+ let name = dropExtension . dropExtension $ takeFileName tarball
+ unpack = fromMaybe . error $ "gmpRules: expected suffix "
+ ++ "-nodoc-patched (found: " ++ name ++ ")."
+ libName = unpack $ stripSuffix "-nodoc-patched" name
+
+ moveDirectory (tmp -/- libName) gmpBuildPath
+
+ -- Run GMP's configure script
+ gmpBuildPath -/- "Makefile" %> \mk -> do
+ env <- configureEnvironment
+ need [mk <.> "in"]
+ buildWithCmdOptions env $
+ Target gmpContext (Configure gmpBuildPath) [mk <.> "in"] [mk]
diff --git a/src/Settings/Paths.hs b/src/Settings/Paths.hs
index 51e92e2..9c770f3 100644
--- a/src/Settings/Paths.hs
+++ b/src/Settings/Paths.hs
@@ -1,7 +1,7 @@
module Settings.Paths (
contextDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
- pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpLibrary, gmpObjects,
- gmpLibraryH, gmpBuildInfoPath, libffiBuildPath, shakeFilesPath, pkgConfFile,
+ pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpObjects, gmpLibraryH,
+ gmpBuildInfoPath, libffiBuildPath, shakeFilesPath, pkgConfFile,
packageDbDirectory, bootPackageConstraints, packageDependencies
) where
@@ -66,10 +66,6 @@ pkgFile context prefix suffix = do
gmpBuildPath :: FilePath
gmpBuildPath = buildRootPath -/- "stage1/gmp"
--- | Path to the GMP library.
-gmpLibrary :: FilePath
-gmpLibrary = gmpBuildPath -/- "libgmp.a"
-
-- | Path to the GMP library header.
gmpLibraryH :: FilePath
gmpLibraryH = gmpBuildPath -/- "include/ghc-gmp.h"
More information about the ghc-commits
mailing list