hadrian: Use --make mode rather than -c for compiling libraries

Experiment, this will probably be faster when we have -jsem

13 files changed, 126 insertions, 29 deletions

diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index da0aa4daab..a855dda4ba 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -154,6 +154,7 @@ executable hadrian
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
                        , text                 >= 1.2     && < 3
+                       , time
     ghc-options:       -Wall
                        -Wincomplete-record-updates
                        -Wredundant-constraints
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index f3c6f80d41..74e7fd2e77 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -3,7 +3,7 @@ module Builder (
     -- * Data types
     ArMode (..), CcMode (..), ConfigurationInfo (..), DependencyType (..),
     GhcMode (..), GhcPkgMode (..), HaddockMode (..), TestMode(..), SphinxMode (..),
-    TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..),
+    TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..), MakeOrOneShot(..),
 
     -- * Builder properties
     builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
@@ -61,7 +61,8 @@ instance NFData   DependencyType
 -- * Compile a C source file.
 -- * Extract source dependencies by passing @-M@ command line argument.
 -- * Link object files & static libraries into an executable.
-data GhcMode = CompileHs
+
+data GhcMode = CompileHs MakeOrOneShot
              | CompileCWithGhc
              | CompileCppWithGhc
              | FindHsDependencies
@@ -69,10 +70,16 @@ data GhcMode = CompileHs
              | ToolArgs
     deriving (Eq, Generic, Show)
 
+data MakeOrOneShot = GhcMake | GhcOneShot deriving (Eq, Generic, Show)
+
 instance Binary   GhcMode
 instance Hashable GhcMode
 instance NFData   GhcMode
 
+instance Binary   MakeOrOneShot
+instance Hashable MakeOrOneShot
+instance NFData   MakeOrOneShot
+
 -- | To configure a package we need two pieces of information, which we choose
 -- to record separately for convenience.
 --
@@ -383,6 +390,11 @@ instance H.Builder Builder where
                   when (code /= ExitSuccess) $ do
                     fail "tests failed"
 
+                Ghc (CompileHs GhcMake) _ -> do
+                  Exit code <- cmd [path] buildArgs
+                  when (code /= ExitSuccess) $ do
+                    fail "build failed"
+
                 _  -> cmd' [path] buildArgs
 
 -- TODO: Some builders are required only on certain platforms. For example,
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index 81bff8a11f..809cc95be7 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -8,7 +8,7 @@ module Context (
     -- * Paths
     contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
     pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
-    pkgLibraryFile, pkgGhciLibraryFile,
+    pkgLibraryFile, pkgGhciLibraryFile, pkgStampFile,
     pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir,
     haddockStatsFilesDir
     ) where
@@ -132,6 +132,11 @@ pkgConfFile Context {..} = do
     dbPath <- packageDbPath stage
     return $ dbPath -/- pid <.> "conf"
 
+pkgStampFile :: Context -> Action FilePath
+pkgStampFile c@Context{..} = do
+    let extension = waySuffix way
+    pkgFile c "stamp-" extension
+
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
 -- to its object file. For example:
 -- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs
index 14b08cb0e9..3d113d3313 100644
--- a/hadrian/src/Expression.hs
+++ b/hadrian/src/Expression.hs
@@ -79,6 +79,13 @@ instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
             Ghc c _ -> builder (f c)
             _       -> return False
 
+instance BuilderPredicate a => BuilderPredicate (MakeOrOneShot -> a) where
+    builder f = do
+        b <- getBuilder
+        case b of
+            Ghc (CompileHs mode)  _ -> builder (f mode)
+            _       -> return False
+
 instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
     builder f = do
         b <- getBuilder
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index 3b81c3fd77..da8bc00bae 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -111,7 +111,7 @@ werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror")
 -- | Build C and Haskell objects with debugging information.
 enableDebugInfo :: Flavour -> Flavour
 enableDebugInfo = addArgs $ notStage0 ? mconcat
-    [ builder (Ghc CompileHs) ? arg "-g3"
+    [ builder (Ghc . CompileHs) ? arg "-g3"
     , builder (Cc CompileC) ? arg "-g3"
     , builder (Cabal Setup) ? arg "--disable-library-stripping"
     , builder (Cabal Setup) ? arg "--disable-executable-stripping"
@@ -121,7 +121,7 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat
 enableTickyGhc :: Flavour -> Flavour
 enableTickyGhc =
     addArgs $ stage1 ? mconcat
-      [ builder (Ghc CompileHs) ? ticky
+      [ builder (Ghc . CompileHs) ? ticky
       , builder (Ghc LinkHs) ? ticky
       ]
   where
@@ -138,7 +138,7 @@ enableTickyGhc =
 enableLinting :: Flavour -> Flavour
 enableLinting =
     addArgs $ stage1 ? mconcat
-      [ builder (Ghc CompileHs) ? lint
+      [ builder (Ghc . CompileHs) ? lint
       ]
   where
     lint = mconcat
@@ -149,7 +149,7 @@ enableLinting =
 enableHaddock :: Flavour -> Flavour
 enableHaddock =
     addArgs $ stage1 ? mconcat
-      [ builder (Ghc CompileHs) ? haddock
+      [ builder (Ghc . CompileHs) ? haddock
       ]
   where
     haddock = mconcat
@@ -170,7 +170,7 @@ splitSectionsIf pkgPredicate = addArgs $ do
     osx <- expr isOsxTarget
     not osx ? -- osx doesn't support split sections
       pkgPredicate pkg ? -- Only apply to these packages
-        builder (Ghc CompileHs) ? arg "-split-sections"
+        builder (Ghc . CompileHs) ? arg "-split-sections"
 
 -- | Like 'splitSectionsIf', but with a fixed predicate: use
 --   split sections for all packages but the GHC library.
@@ -181,7 +181,7 @@ splitSections = splitSectionsIf (/=ghc)
 
 enableThreadSanitizer :: Flavour -> Flavour
 enableThreadSanitizer = addArgs $ mconcat
-    [ builder (Ghc CompileHs) ? arg "-optc-fsanitize=thread"
+    [ builder (Ghc . CompileHs) ? arg "-optc-fsanitize=thread"
     , builder (Ghc CompileCWithGhc) ? (arg "-optc-fsanitize=thread" <> arg "-DTSAN_ENABLED")
     , builder (Ghc LinkHs) ? arg "-optl-fsanitize=thread"
     , builder (Cc  CompileC) ? (arg "-fsanitize=thread" <> arg "-DTSAN_ENABLED")
@@ -224,19 +224,19 @@ disableProfiledLibs flavour =
 -- recompilation.
 omitPragmas :: Flavour -> Flavour
 omitPragmas = addArgs
-    $ notStage0 ? builder (Ghc CompileHs) ? package compiler
+    $ notStage0 ? builder (Ghc . CompileHs) ? package compiler
     ? arg "-fomit-interface-pragmas"
 
 -- | Build stage2 dependencies with options to enable IPE debugging
 -- information.
 enableIPE :: Flavour -> Flavour
 enableIPE = addArgs
-    $ notStage0 ? builder (Ghc CompileHs)
+    $ notStage0 ? builder (Ghc . CompileHs)
     ? pure ["-finfo-table-map", "-fdistinct-constructor-tables"]
 
 enableLateCCS :: Flavour -> Flavour
 enableLateCCS = addArgs
-  $ notStage0 ? builder (Ghc CompileHs)
+  $ notStage0 ? builder (Ghc . CompileHs)
   ? arg "-fprof-late"
 
 -- | Enable assertions for the stage2 compiler
@@ -281,7 +281,7 @@ fullyStatic flavour =
          - an executable (where their position is not at the beginning of
          - the file).
          -}
-        , builder (Ghc CompileHs) ? pure [ "-fPIC", "-static" ]
+        , builder (Ghc . CompileHs) ? pure [ "-fPIC", "-static" ]
         , builder (Ghc CompileCWithGhc) ? pure [ "-fPIC", "-optc", "-static"]
         , builder (Ghc LinkHs) ? pure [ "-optl", "-static" ]
         ]
@@ -297,7 +297,7 @@ collectTimings =
   -- that has been causing the allocation. So we want -v.
   -- On the other hand, -v doesn't work with -ddump-to-file, so we need
   -- -ddump-timings.
-  addArgs $ notStage0 ? builder (Ghc CompileHs) ?
+  addArgs $ notStage0 ? builder (Ghc . CompileHs) ?
     pure ["-ddump-to-file", "-ddump-timings", "-v"]
 
 -- | Build ghc with debug rts (i.e. -debug) in and after this stage
@@ -508,7 +508,7 @@ builderSetting =
           [ ("c", CompileCWithGhc)
           , ("cpp", CompileCppWithGhc)
           , ("deps", FindHsDependencies)
-          , ("hs", CompileHs)
+          , ("hs", CompileHs GhcMake)
           , ("link", LinkHs)
           , ("toolargs", ToolArgs)
           ]
diff --git a/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs b/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
index 2a17a6ad69..486b05c0ef 100644
--- a/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
+++ b/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
@@ -58,7 +58,7 @@ cabalOracle = do
         putVerbose $ "| PackageConfiguration oracle: configuring "
                ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..."
         -- Configure the package with the GHC corresponding to the given stage
-        hcPath <- builderPath (Ghc CompileHs stage)
+        hcPath <- builderPath (Ghc (CompileHs GhcMake) stage)
         hcPkgPath <- builderPath (GhcPkg undefined stage)
         -- N.B. the hcPath parameter of `configure` is broken when given an
         -- empty ProgramDb. To work around this we manually construct an
diff --git a/hadrian/src/Rules/Compile.hs b/hadrian/src/Rules/Compile.hs
index afa5abbcca..96c6ddc93a 100644
--- a/hadrian/src/Rules/Compile.hs
+++ b/hadrian/src/Rules/Compile.hs
@@ -207,7 +207,15 @@ compileHsObjectAndHi rs objpath = do
     <- parsePath (parseBuildObject root) "<object file path parser>" objpath
   let ctx = objectContext b
       way = C.way ctx
+  lib_ways <- interpretInContext ctx getLibraryWays
   ctxPath <- contextPath ctx
+  -- Need the stamp file, which triggers a rebuild via make
+  stamp <- pkgStampFile ctx
+  if way == dynamic && vanilla `elem` lib_ways
+    then return ()
+    else need [stamp]
+
+  {-
   (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
   need (src:deps)
 
@@ -221,6 +229,7 @@ compileHsObjectAndHi rs objpath = do
              ]
 
   buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
+  -}
 
 compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action ()
 compileNonHsObject rs lang path = do
@@ -232,7 +241,7 @@ compileNonHsObject rs lang path = do
     builder = case lang of
       C -> Ghc CompileCWithGhc
       Cxx-> Ghc CompileCppWithGhc
-      _ -> Ghc CompileHs
+      _ -> Ghc (CompileHs GhcOneShot)
   src <- case lang of
       Asm -> obj2src "S"   (const False)      ctx path
       C   -> obj2src "c"   (const False)      ctx path
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index bb502f9875..1a8ea966e0 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -15,6 +15,11 @@ import Rules.Register
 import Settings
 import Target
 import Utilities
+import Data.Time.Clock
+import Rules.Generate (generatedDependencies)
+import Hadrian.Oracles.Cabal (readPackageData)
+import Flavour
+import Oracles.Flag
 
 -- * Library 'Rules'
 
@@ -25,6 +30,7 @@ libraryRules = do
     root -/- "**/libHS*-*.so"          %> buildDynamicLib root "so"
     root -/- "**/libHS*-*.dll"         %> buildDynamicLib root "dll"
     root -/- "**/*.a"                  %> buildStaticLib  root
+    root -/- "**/stamp-*"              %> buildPackage root
     priority 2 $ do
         root -/- "stage*/lib/**/libHS*-*.dylib" %> registerDynamicLib root "dylib"
         root -/- "stage*/lib/**/libHS*-*.so"    %> registerDynamicLib root "so"
@@ -48,6 +54,35 @@ registerStaticLib root archivePath = do
                 -/- (pkgId name version) ++ ".conf"
          ]
 
+buildPackage :: FilePath -> FilePath -> Action ()
+buildPackage root fp = do
+  l@(BuildPath _ stage _ (PkgStamp pkgname ver way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp
+  let ctx = stampContext l
+  srcs <- hsSources ctx
+  gens <- interpretInContext ctx generatedDependencies
+
+  depPkgs <- packageDependencies <$> readPackageData (package ctx)
+  -- Stage packages are those we have in this stage.
+  stagePkgs <- stagePackages stage
+  -- We'll need those packages in our package database.
+  deps <- sequence [ pkgConfFile (ctx { package = pkg })
+                   | pkg <- depPkgs, pkg `elem` stagePkgs ]
+  need deps
+  need (srcs ++ gens)
+  unless (null srcs) (build $ target ctx (Ghc (CompileHs GhcMake) stage) srcs [])
+  time <- liftIO $ getCurrentTime
+  liftIO $ writeFile fp (show time)
+  ways <- interpretInContext ctx getLibraryWays
+  let hasVanilla = elem vanilla ways
+      hasDynamic = elem dynamic ways
+  support <- platformSupportsSharedLibs
+  when ((hasVanilla && hasDynamic) &&
+        support && way == vanilla) $ do
+    stamp <- (pkgStampFile (ctx { way = dynamic }))
+    liftIO $ writeFile stamp (show time)
+
+
+
 -- | Build a static library ('LibA') under the given build root, whose path is
 -- the second argument.
 buildStaticLib :: FilePath -> FilePath -> Action ()
@@ -178,6 +213,8 @@ data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)
 -- | > HS<pkg name>-<pkg version>[_<way suffix>].o
 data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)
 
+data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show)
+
 -- | Get the 'Context' corresponding to the build path for a given static library.
 libAContext :: BuildPath LibA -> Context
 libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
@@ -185,6 +222,13 @@ libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
   where
     pkg = library pkgname pkgpath
 
+-- | Get the 'Context' corresponding to the build path for a given static library.
+stampContext :: BuildPath PkgStamp -> Context
+stampContext (BuildPath _ stage pkgpath (PkgStamp pkgname _ way)) =
+    Context stage pkg way
+  where
+    pkg = unsafeFindPackageByName pkgname
+
 -- | Get the 'Context' corresponding to the build path for a given GHCi library.
 libGhciContext :: BuildPath LibGhci -> Context
 libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
@@ -221,6 +265,11 @@ parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
 parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
     Parsec.<?> "build path for a ghci library"
 
+-- | Parse a path to a ghci library to be built, making sure the path starts
+-- with the given build root.
+parseStampPath :: FilePath -> Parsec.Parsec String () (BuildPath PkgStamp)
+parseStampPath root = parseBuildPath root parseStamp
+
 -- | Parse a path to a dynamic library to be built, making sure the path starts
 -- with the given build root.
 parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
@@ -262,6 +311,14 @@ parseLibDynFilename ext = do
     _ <- Parsec.string ("." ++ ext)
     return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
 
+-- | Parse the filename of a static library to be built into a 'LibA' value.
+parseStamp :: Parsec.Parsec String () PkgStamp
+parseStamp = do
+    _ <- Parsec.string "stamp-"
+    (pkgname, pkgver) <- parsePkgId
+    way <- parseWaySuffix vanilla
+    return (PkgStamp pkgname pkgver way)
+
 -- | Get the package identifier given the package name and version.
 pkgId :: String -> [Integer] -> String
 pkgId name version = name ++ "-" ++ intercalate "." (map show version)
diff --git a/hadrian/src/Rules/Nofib.hs b/hadrian/src/Rules/Nofib.hs
index 1e7550b480..e8e9fe8be6 100644
--- a/hadrian/src/Rules/Nofib.hs
+++ b/hadrian/src/Rules/Nofib.hs
@@ -28,7 +28,7 @@ nofibRules = do
 
         makePath <- builderPath (Make "nofib")
         top      <- topDirectory
-        ghcPath  <- builderPath (Ghc CompileHs Stage2)
+        ghcPath  <- builderPath (Ghc (CompileHs GhcMake) Stage2)
 
         -- some makefiles in nofib rely on a $MAKE
         -- env var being defined
@@ -53,4 +53,4 @@ needNofibDeps = do
     unlitPath <- programPath (vanillaContext Stage1 unlit)
     mtlPath   <- pkgConfFile (vanillaContext Stage1 mtl  )
     need [ unlitPath, mtlPath ]
-    needBuilder (Ghc CompileHs Stage2)
+    needBuilder (Ghc (CompileHs GhcMake) Stage2)
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index 154496cf1c..86699b65d9 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -290,7 +290,6 @@ needTestsuitePackages stg = do
   cross <- flag CrossCompiling
   when (not cross) $ needIservBins stg
   root <- buildRoot
-  liftIO $ print stg
   -- require the shims for testing stage1
   when (stg == stage0InTree) $ do
    -- Windows not supported as the wrapper scripts don't work on windows.. we could
diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs
index dfd322b28d..85be484cfe 100644
--- a/hadrian/src/Settings/Builders/Cabal.hs
+++ b/hadrian/src/Settings/Builders/Cabal.hs
@@ -112,8 +112,8 @@ commonCabalArgs stage = do
             , arg "--htmldir"
             , arg $ "${pkgroot}/../../docs/html/libraries/" ++ package_id
 
-            , withStaged $ Ghc CompileHs
-            , withBuilderArgs (Ghc CompileHs stage)
+            , withStaged $ Ghc (CompileHs GhcMake)
+            , withBuilderArgs (Ghc (CompileHs GhcMake) stage)
             , withStaged (GhcPkg Update)
             , withBuilderArgs (GhcPkg Update stage)
             , bootPackageDatabaseArgs
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 7deb22f179..92b259983e 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -28,7 +28,7 @@ ghcBuilderArgs = mconcat
       let nextStageRtsBuildIncludeDir = nextStageRtsBuildDir </> "include"
       builder Ghc ? arg ("-I" ++ nextStageRtsBuildIncludeDir)
   , compileAndLinkHs, compileC, compileCxx, findHsDependencies
-  , toolArgs]
+  , toolArgs ]
 
 toolArgs :: Args
 toolArgs = do
@@ -40,28 +40,35 @@ toolArgs = do
               , map ("-optP" ++) <$> getContextData cppOpts
               ]
 
+
 compileAndLinkHs :: Args
-compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
+compileAndLinkHs = (builder (Ghc . CompileHs) ||^ builder (Ghc LinkHs)) ? do
     ways <- getLibraryWays
     useColor <- shakeColor <$> expr getShakeOptions
     let hasVanilla = elem vanilla ways
         hasDynamic = elem dynamic ways
     mconcat [ arg "-Wall"
             , arg "-Wcompat"
-            , not useColor ? builder (Ghc CompileHs) ?
+            , not useColor ? builder (Ghc . CompileHs) ?
               -- N.B. Target.trackArgument ignores this argument from the
               -- input hash to avoid superfluous recompilation, avoiding
               -- #18672.
               arg "-fdiagnostics-color=never"
-            , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ?
+            , (hasVanilla && hasDynamic) ? builder (Ghc . CompileHs) ?
               platformSupportsSharedLibs ? way vanilla ?
               arg "-dynamic-too"
             , commonGhcArgs
             , ghcLinkArgs
             , defaultGhcWarningsArgs
-            , builder (Ghc CompileHs) ? arg "-c"
+            , builder (Ghc (CompileHs GhcOneShot)) ? mconcat [
+                arg "-c" ]
+            , builder (Ghc (CompileHs GhcMake)) ? mconcat
+                [ arg "--make"
+                , arg "-no-link" ]
             , getInputs
-            , arg "-o", arg =<< getOutput ]
+            , notM (builder (Ghc (CompileHs GhcMake))) ? mconcat
+                [arg "-o", arg =<< getOutput]
+            ]
 
 compileC :: Args
 compileC = builder (Ghc CompileCWithGhc) ? do
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index aa61147ccd..042668cb9d 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -51,7 +51,7 @@ packageArgs = do
         , package compiler ? mconcat
           [ builder Alex ? arg "--latin1"
 
-          , builder (Ghc CompileHs) ? mconcat
+          , builder (Ghc . CompileHs) ? mconcat
             [ debugAssertions ? notStage0 ? arg "-DDEBUG"
 
             , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"