Hadrian: refactor GMP in-tree build support (#17756)

* Hadrian doesn't use integer-gmp/config.mk file anymore to determine if
  building GMP in-tree is required.

  "config.mk" is created by Cabal when the integer-gmp package is
  configured and this file is still untracked by Hadrian. This led to a
  tricky configure "race" because "config.mk" is built by the
  "setup-config" rule, but this rule is also used to find dependencies,
  in particular the "ghc-gmp.h" header, but the creation of this file
  was depending (without being tracked) on "config.mk".

  Now Hadrian only builds in-tree GMP if `--with-intree-gmp` is passed
  to the top-level configure script.

* in-tree GMP isn't built once for all in a fixed stage (Stage1)
  anymore. It is built per stage which is required if we build a
  cross-compiler

* switching between in-tree and external GMP is now supported without
  having to clean the build directory first.

* "wrappers.c" now includes "ghc-gmp.h" instead of "ghc.h". It
  helps ensuring that the build system generates "ghc-gmp.h".

* build in-tree GMP in "<root>/stageN/gmp/gmpbuild" and produce useful
  artefacts (libgmp.a, gmp.h, objs/*.o) in "<root>/stageN/gmp"

7 files changed, 144 insertions, 116 deletions

diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index c65d852931..89642896a6 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -15,7 +15,6 @@ import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Packages
-import Rules.Gmp
 import Rules.Libffi
 import Settings
 import Settings.Builders.DeriveConstants (deriveConstantsPairs)
@@ -53,11 +52,11 @@ compilerDependencies = do
     stage   <- getStage
     isGmp   <- (== integerGmp) <$> getIntegerPackage
     ghcPath <- expr $ buildPath (vanillaContext stage compiler)
-    gmpPath <- expr gmpBuildPath
+    gmpPath <- expr $ buildPath (vanillaContext stage integerGmp)
     rtsPath <- expr (rtsBuildPath stage)
     libDir <- expr $ stageLibPath stage
     mconcat [ return $ (libDir -/-) <$> derivedConstantsFiles
-            , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
+            , notStage0 ? isGmp ? return [gmpPath -/- "include/ghc-gmp.h"]
             , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles)
             , return $ fmap (ghcPath -/-)
                   [ "primop-can-fail.hs-incl"
diff --git a/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
index 61fb4125d3..0524fbed98 100644
--- a/hadrian/src/Rules/Gmp.hs
+++ b/hadrian/src/Rules/Gmp.hs
@@ -1,129 +1,158 @@
-module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH) where
+module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects) where
 
 import Base
 import Context
 import Oracles.Setting
+import Oracles.Flag
 import Packages
 import Target
 import Utilities
+import Hadrian.BuildPath
 
 -- | 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"])
+gmpObjects :: Stage -> Action [FilePath]
+gmpObjects s = do
+  isInTree <- flag GmpInTree
+  if not isInTree
+    then return []
+    else do
+      -- Indirectly ensure object creation
+      let ctx = vanillaContext s integerGmp
+      integerGmpPath <- buildPath ctx
+      need [integerGmpPath -/- "include/ghc-gmp.h"]
+
+      -- 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.
+      gmpPath <- gmpIntreePath s
+      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")
+gmpBuildPath :: Stage -> Action FilePath
+gmpBuildPath s = gmpIntreePath s <&> (-/- "gmpbuild")
 
--- | GMP library header, relative to 'gmpBuildPath'.
-gmpLibraryH :: FilePath
-gmpLibraryH = "include/ghc-gmp.h"
+gmpIntreePath :: Stage -> Action FilePath
+gmpIntreePath s = buildRoot <&> (-/- stageString s -/- "gmp")
 
--- | Directory for GMP library object files, relative to 'gmpBuildPath'.
+-- | Directory for GMP library object files, relative to 'gmpIntreePath'.
 gmpObjectsDir :: FilePath
 gmpObjectsDir = "objs"
 
-configureEnvironment :: Action [CmdOption]
-configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
-                                , builderEnvironment "AR" (Ar Unpack Stage1)
-                                , builderEnvironment "NM" Nm ]
+configureEnvironment :: Stage -> Action [CmdOption]
+configureEnvironment s = sequence [ builderEnvironment "CC" $ Cc CompileC s
+                                  , builderEnvironment "AR" (Ar Unpack s)
+                                  , 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" ]
+    root <- buildRootRules
+
+    -- Build in-tree gmp if necessary
+    -- Produce: integer-gmp/build/include/ghc-gmp.h
+    --   In-tree: copy gmp.h from in-tree build
+    --   External: copy ghc-gmp.h from base sources
+    root -/- "stage*/libraries/integer-gmp/build/include/ghc-gmp.h" %> \header -> do
+        let includeP   = takeDirectory header
+            buildP     = takeDirectory includeP
+            packageP   = takeDirectory buildP
+            librariesP = takeDirectory packageP
+            stageP     = takeDirectory librariesP
+
+        isInTree <- flag GmpInTree
+
+        if windowsHost || isInTree  -- TODO: We don't use system GMP on Windows. Fix?
         then do
+            putBuild "| No GMP library/framework detected; in tree GMP will be built"
+            let intreeHeader = stageP -/- "gmp/gmp.h"
+            need [intreeHeader]
+            copyFile intreeHeader header
+        else 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)
+
+    -- Build in-tree GMP library for the current stage, prioritised so that it
+    -- matches "before" the generic @.a@ library rule in 'Rules.Library'.
+    priority 2.0 $ do
+
+        let
+          -- parse a path of the form "//stage*/gmp/xxx" and returns a vanilla
+          -- context from it for integer-gmp package.
+          makeGmpPathContext gmpP = do
+               let
+                   stageP   = takeDirectory gmpP
+                   stageS   = takeFileName stageP
+               stage <- parsePath parseStage "<stage>" stageS
+               pure (vanillaContext stage integerGmp)
+
+          gmpPath = root -/- "stage*/gmp"
+
+        -- Build in-tree gmp. Produce:
+        --  - <root>/stageN/gmp/gmp.h
+        --  - <root>/stageN/gmp/libgmp.a
+        --  - <root>/stageN/gmp/objs/*.o (unpacked objects from libgmp.a)
+        [gmpPath -/- "libgmp.a", gmpPath -/- "gmp.h"] &%> \[lib,header] -> do
+            let gmpP = takeDirectory lib
+            ctx <- makeGmpPathContext gmpP
+            -- build libgmp.a via gmp's Makefile
+            build $ target ctx (Make (gmpP -/- "gmpbuild")) [gmpP -/- "gmpbuild/Makefile"] []
+            -- copy header and lib to their final destination
+            copyFileUntracked (gmpP -/- "gmpbuild/.libs/libgmp.a") lib
+            copyFileUntracked (gmpP -/- "gmpbuild/gmp.h")          header
+            -- we also unpack objects from libgmp.a into "objs" directory
+            createDirectory (gmpP -/- gmpObjectsDir)
             top <- topDirectory
-            build $ target gmpContext (Ar Unpack Stage1)
-                [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
-            objs <- liftIO $ getDirectoryFilesIO "." [gmpPath -/- gmpObjectsDir -/- "*"]
+            build $ target ctx (Ar Unpack (stage ctx))
+                [top -/- gmpP -/- "libgmp.a"] [gmpP -/- gmpObjectsDir]
+            objs <- liftIO $ getDirectoryFilesIO "." [gmpP -/- 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
+            putSuccess "| Successfully built custom library 'gmp'"
+
+        -- Run GMP's configure script. Produce:
+        --  - <root>/stageN/gmp/gmpbuild/Makefile
+        gmpPath -/- "gmpbuild/Makefile" %> \mk -> do
+            let gmpBuildP = takeDirectory mk
+                gmpP      = takeDirectory gmpBuildP
+            ctx <- makeGmpPathContext gmpP
+            env <- configureEnvironment (stage ctx)
+            need [mk <.> "in"]
+            buildWithCmdOptions env $
+                target gmpContext (Configure gmpBuildP) [mk <.> "in"] [mk]
+
+        -- Extract in-tree GMP sources and apply patches. Produce
+        --  - <root>/stageN/gmp/gmpbuild/Makefile.in
+        --  - <root>/stageN/gmp/gmpbuild/configure
+        [gmpPath -/- "gmpbuild/Makefile.in", gmpPath -/- "gmpbuild/configure"] &%> \[mkIn,_] -> do
+            top <- topDirectory
+            let destPath = takeDirectory mkIn
+            removeDirectory destPath
+            -- 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) destPath
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index 320f45a878..5f839215dc 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -7,7 +7,7 @@ import qualified Text.Parsec      as Parsec
 
 import Base
 import Context
-import Expression hiding (way, package)
+import Expression hiding (way, package, stage)
 import Oracles.ModuleFiles
 import Packages
 import Rules.Gmp
@@ -134,7 +134,7 @@ cObjects context = do
 -- 'Context' is @integer-gmp@.
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
-    | package context == integerGmp = gmpObjects
+    | package context == integerGmp = gmpObjects (stage context)
     | otherwise                     = return []
 
 -- | Return all the object files to be put into the library we're building for
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index e0b0926e6a..fdb3202afe 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -11,7 +11,6 @@ import Hadrian.Expression
 import Hadrian.Haskell.Cabal
 import Oracles.Setting
 import Packages
-import Rules.Gmp
 import Rules.Rts
 import {-# SOURCE #-} Rules.Library (needLibrary)
 import Settings
@@ -40,6 +39,9 @@ configurePackageRules = do
         (stage, path) <- parsePath (parseSetupConfig root) "<setup config path parser>" out
         let pkg = unsafeFindPackageByPath path
         let ctx = Context stage pkg vanilla
+        buildP <- buildPath ctx
+        when (pkg == integerGmp) $
+          need [buildP -/- "include/ghc-gmp.h"]
         needLibrary =<< contextDependencies ctx
         Cabal.configurePackage ctx
 
@@ -127,7 +129,9 @@ buildConf _ context@Context {..} conf = do
              , path -/- "ghcplatform.h"
              , path -/- "ghcversion.h" ]
 
-    when (package == integerGmp) $ need [path -/- gmpLibraryH]
+    -- we need to generate this file for GMP
+    when (package == integerGmp) $
+        need [path -/- "include/ghc-gmp.h"]
 
     -- Copy and register the package.
     Cabal.copyPackage context
diff --git a/hadrian/src/Settings/Builders/Configure.hs b/hadrian/src/Settings/Builders/Configure.hs
index e8384e28d9..885f6a3f1f 100644
--- a/hadrian/src/Settings/Builders/Configure.hs
+++ b/hadrian/src/Settings/Builders/Configure.hs
@@ -6,8 +6,8 @@ import Settings.Builders.Common
 
 configureBuilderArgs :: Args
 configureBuilderArgs = do
-    gmpPath    <- expr gmpBuildPath
     stage      <- getStage
+    gmpPath    <- expr (gmpBuildPath stage)
     libffiPath <- expr (libffiBuildPath stage)
     mconcat [ builder (Configure gmpPath) ? do
                 targetPlatform <- getSetting TargetPlatform
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 431c2cb22e..12f01e7774 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -10,7 +10,8 @@ import CommandLine
 makeBuilderArgs :: Args
 makeBuilderArgs = do
     threads    <- shakeThreads <$> expr getShakeOptions
-    gmpPath    <- expr gmpBuildPath
+    stage      <- getStage
+    gmpPath    <- expr (gmpBuildPath stage)
     libffiPaths <- forM [Stage1 ..] $ \s -> expr (libffiBuildPath s)
     let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
     mconcat $
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index d0dbabde99..67933d66cd 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -5,7 +5,6 @@ import Flavour
 import Oracles.Setting
 import Oracles.Flag
 import Packages
-import Rules.Gmp
 import Settings
 
 -- | Package-specific command-line arguments.
@@ -16,9 +15,7 @@ packageArgs = do
     path         <- getBuildPath
     intLib       <- getIntegerPackage
     compilerPath <- expr $ buildPath (vanillaContext stage compiler)
-    gmpBuildPath <- expr gmpBuildPath
-    let includeGmp = "-I" ++ gmpBuildPath -/- "include"
-        -- Do not bind the result to a Boolean: this forces the configure rule
+    let -- Do not bind the result to a Boolean: this forces the configure rule
         -- immediately and may lead to cyclic dependencies.
         -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809.
         cross = flag CrossCompiling
@@ -150,17 +147,15 @@ packageArgs = do
 
         ------------------------------ integerGmp ------------------------------
         , package integerGmp ? mconcat
-          [ builder Cc ? arg includeGmp
-
-          , builder (Cabal Setup) ? mconcat
+          [ builder (Cabal Setup) ? mconcat
             [ flag GmpInTree ? arg "--configure-option=--with-intree-gmp"
             -- Windows is always built with inplace GMP until we have dynamic
             -- linking working.
             , windowsHost  ? arg "--configure-option=--with-intree-gmp"
             , flag GmpFrameworkPref ?
               arg "--configure-option=--with-gmp-framework-preferred"
-            , arg ("--configure-option=CFLAGS=" ++ includeGmp)
-            , arg ("--gcc-options="             ++ includeGmp) ] ]
+            ]
+          ]
 
         ---------------------------------- rts ---------------------------------
         , package rts ? rtsPackageArgs -- RTS deserves a separate function