[commit: hadrian] master: Fix integer-gmp build (#568) (c190ab6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/hadrian

On branch  : master
Link       : http://git.haskell.org/hadrian.git/commitdiff/c190ab6eeda6cfa0782269d4f2d38c64aa65fd17

>---------------------------------------------------------------

commit c190ab6eeda6cfa0782269d4f2d38c64aa65fd17
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Apr 16 02:10:17 2018 +0100

    Fix integer-gmp build (#568)
    
    * Fix path to GMP's config.mk
    
    * Minor revision
    
    * Relocate GMP's build artefacts


>---------------------------------------------------------------

c190ab6eeda6cfa0782269d4f2d38c64aa65fd17
 src/Rules/Gmp.hs     | 15 +++++++++------
 src/Rules/Library.hs | 34 +++++++++++++++-------------------
 2 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs
index 89a88e4..8852311 100644
--- a/src/Rules/Gmp.hs
+++ b/src/Rules/Gmp.hs
@@ -22,9 +22,13 @@ gmpLibrary = ".libs/libgmp.a"
 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 <&> (-/- buildDir gmpContext -/- "gmp")
+gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
 
 -- | GMP library header, relative to 'gmpBuildPath'.
 gmpLibraryH :: FilePath
@@ -45,7 +49,7 @@ gmpRules = do
     root <- buildRootRules
     root <//> gmpLibraryH %> \header -> do
         windows  <- windowsHost
-        configMk <- readFile' =<< (gmpBuildPath <&> (-/- "config.mk"))
+        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
@@ -75,14 +79,13 @@ gmpRules = do
 
     -- This causes integerGmp package to be configured, hence creating the files
     root <//> "gmp/config.mk" %> \_ -> do
-        -- setup-config, triggers `ghc-cabal configure`
-        -- everything of a package should depend on that
-        -- in the first place.
+        -- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
+        -- Building anything in a package transitively depends on its configuration.
         setupConfig <- contextPath gmpContext <&> (-/- "setup-config")
         need [setupConfig]
 
-    -- Run GMP's configure script
     -- TODO: Get rid of hard-coded @gmp at .
+    -- Run GMP's configure script
     root <//> "gmp/Makefile" %> \mk -> do
         env     <- configureEnvironment
         gmpPath <- gmpBuildPath
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index e9f8ff6..000d032 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -23,34 +23,30 @@ import qualified System.Directory as IO
 archive :: Way -> String -> String
 archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a")
 
--- | Building a library consist of building
--- the artifacts, and copying it somewhere
--- with cabal, and finally registering it
--- with the compiler via cabal in the
--- package database.
---
--- So we'll assume rules to build all the
--- package artifacts, and provide rules for
--- the any of the library artifacts.
+-- TODO: This comment is rather vague, make it more precise by listing what
+-- exactly gets built and moved where, referencing the corresponding rules.
+-- | Building a library consist of building the artefacts, copying it somewhere
+-- with Cabal, and finally registering it with the compiler via Cabal in the
+-- package database. We assume rules to build all the package artefacts, and
+-- provide rules for the library artefacts.
 library :: Context -> Rules ()
 library context at Context{..} = do
     root <- buildRootRules
     pkgId <- case pkgCabalFile package of
-      Just file -> liftIO $ parseCabalPkgId file
-      Nothing   -> return (pkgName package)
+        Just file -> liftIO $ parseCabalPkgId file
+        Nothing   -> return $ pkgName package
 
-    root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ -> do
+    root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ ->
         need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId]
-        return ()
 
 libraryObjects :: Context -> Action [FilePath]
 libraryObjects context at Context{..} = do
-    hsObjs   <- hsObjects    context
-    noHsObjs <- nonHsObjects context
+    hsObjs    <- hsObjects    context
+    nonHsObjs <- nonHsObjects context
 
     -- This will create split objects if required (we don't track them
     -- explicitly as this would needlessly bloat the Shake database).
-    need $ noHsObjs ++ hsObjs
+    need $ nonHsObjs ++ hsObjs
 
     split <- interpretInContext context =<< splitObjects <$> flavour
     let getSplitObjs = concatForM hsObjs $ \obj -> do
@@ -58,7 +54,7 @@ libraryObjects context at Context{..} = do
             contents <- liftIO $ IO.getDirectoryContents dir
             return . map (dir -/-) $ filter (not . all (== '.')) contents
 
-    (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
+    (nonHsObjs ++) <$> if split then getSplitObjs else return hsObjs
 
 buildDynamicLib :: Context -> Rules ()
 buildDynamicLib context at Context{..} = do
@@ -106,8 +102,8 @@ buildPackageGhciLibrary :: Context -> Rules ()
 buildPackageGhciLibrary context at Context {..} = priority 2 $ do
     root <- buildRootRules
     pkgId <- case pkgCabalFile package of
-      Just file -> liftIO $ parseCabalPkgId file
-      Nothing   -> return (pkgName package)
+        Just file -> liftIO $ parseCabalPkgId file
+        Nothing   -> return $ pkgName package
 
     let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId
         o = libPrefix ++ "*" ++ (waySuffix way <.> "o")