[commit: ghc] wip/nfs-locking: Add CompilerMode Link. (7bc4867)

[git at git.haskell.org]

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

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/7bc48677710d37d905a1e1b005e8113b28abb473/ghc

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

commit 7bc48677710d37d905a1e1b005e8113b28abb473
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Apr 25 23:51:58 2016 +0100

    Add CompilerMode Link.
    
    See #223.


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

7bc48677710d37d905a1e1b005e8113b28abb473
 src/Builder.hs               | 16 +++++++++-------
 src/Rules/Program.hs         |  3 +--
 src/Settings/Builders/Ghc.hs | 34 ++++++++++++++++++++--------------
 3 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/src/Builder.hs b/src/Builder.hs
index 348e7e9..09e4ab9 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -15,11 +15,14 @@ import Oracles.LookupInPath
 import Oracles.WindowsPath
 import Stage
 
--- TODO: Add Link mode?
--- | A C or Haskell compiler can be used in two modes: for compiling sources
--- into object files, or for extracting source dependencies, e.g. by passing -M
--- command line option.
-data CompilerMode = Compile | FindDependencies deriving (Show, Eq, Generic)
+-- | A compiler can typically be used in one of three modes:
+-- 1) Compiling sources into object files.
+-- 2) Extracting source dependencies, e.g. by passing -M command line argument.
+-- 3) Linking object files & static libraries into an executable.
+data CompilerMode = Compile
+                  | FindDependencies
+                  | Link
+                  deriving (Show, Eq, Generic)
 
 -- TODO: Do we really need HsCpp builder? Can't we use Cc instead?
 -- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
@@ -138,8 +141,7 @@ getBuilderPath = lift . builderPath
 specified :: Builder -> Action Bool
 specified = fmap (not . null) . builderPath
 
--- TODO: split into two functions: needBuilder (without laxDependencies) and
--- unsafeNeedBuilder (with the laxDependencies parameter)
+-- TODO: Get rid of laxDependencies -- we no longer need it (use Shake's skip).
 -- | Make sure a builder exists on the given path and rebuild it if out of date.
 -- If 'laxDependencies' is True then we do not rebuild GHC even if it is out of
 -- date (can save a lot of build time when changing GHC).
diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs
index 975be85..2cee06c 100644
--- a/src/Rules/Program.hs
+++ b/src/Rules/Program.hs
@@ -99,8 +99,7 @@ buildBinary rs context@(Context stage package _) bin = do
                   then [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
                   else objs
     need $ binDeps ++ libs
-    -- TODO: Use Link mode instead of Compile.
-    buildWithResources rs $ Target context (Ghc Compile stage) binDeps [bin]
+    buildWithResources rs $ Target context (Ghc Link stage) binDeps [bin]
     synopsis <- interpretInContext context $ getPkgData Synopsis
     putSuccess $ renderProgram
         ("'" ++ pkgNameString package ++ "' (" ++ show stage ++ ").")
diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs
index a07c512..7152526 100644
--- a/src/Settings/Builders/Ghc.hs
+++ b/src/Settings/Builders/Ghc.hs
@@ -18,8 +18,9 @@ import Settings.Builders.Common (cIncludeArgs)
 --     $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@
 --     $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
 --     $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
+-- TODO: Simplify
 ghcBuilderArgs :: Args
-ghcBuilderArgs = stagedBuilder (Ghc Compile) ? do
+ghcBuilderArgs = (stagedBuilder (Ghc Compile) ||^ stagedBuilder (Ghc Link)) ? do
     output <- getOutput
     stage  <- getStage
     way    <- getWay
@@ -27,16 +28,6 @@ ghcBuilderArgs = stagedBuilder (Ghc Compile) ? do
     let buildObj  = any (\s -> ("//*." ++ s way) ?== output) [ osuf,  obootsuf]
         buildHi   = any (\s -> ("//*." ++ s way) ?== output) [hisuf, hibootsuf]
         buildProg = not (buildObj || buildHi)
-    libs    <- getPkgDataList DepExtraLibs
-    gmpLibs <- if stage > Stage0 && buildProg
-               then do -- TODO: get this data more gracefully
-                   buildInfo <- lift $ readFileLines gmpBuildInfoPath
-                   let extract s = case stripPrefix "extra-libraries: " s of
-                           Nothing    -> []
-                           Just value -> words value
-                   return $ concatMap extract buildInfo
-               else return []
-    libDirs <- getPkgDataList DepLibDirs
     mconcat [ commonGhcArgs
             , arg "-H32m"
             , stage0    ? arg "-O"
@@ -44,14 +35,29 @@ ghcBuilderArgs = stagedBuilder (Ghc Compile) ? do
             , arg "-Wall"
             , arg "-fwarn-tabs"
             , splitObjectsArgs
-            , buildProg ? arg "-no-auto-link-packages"
-            , buildProg ? append [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ]
-            , buildProg ? append [ "-optl-L" ++ dir | dir <- libDirs ]
+            , buildProg ? ghcLinkArgs
             , not buildProg ? arg "-c"
             , append =<< getInputs
             , buildHi ? append ["-fno-code", "-fwrite-interface"]
             , not buildHi ? mconcat [ arg "-o", arg =<< getOutput ] ]
 
+ghcLinkArgs :: Args
+ghcLinkArgs = stagedBuilder (Ghc Link) ? do
+    stage   <- getStage
+    libs    <- getPkgDataList DepExtraLibs
+    gmpLibs <- if stage > Stage0
+               then do -- TODO: get this data more gracefully
+                   buildInfo <- lift $ readFileLines gmpBuildInfoPath
+                   let extract s = case stripPrefix "extra-libraries: " s of
+                           Nothing    -> []
+                           Just value -> words value
+                   return $ concatMap extract buildInfo
+               else return []
+    libDirs <- getPkgDataList DepLibDirs
+    mconcat [ arg "-no-auto-link-packages"
+            , append [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ]
+            , append [ "-optl-L" ++ dir | dir <- libDirs ] ]
+
 needTouchy :: Action ()
 needTouchy =
     whenM windowsHost $ need [fromJust $ programPath (vanillaContext Stage0 touchy)]