[commit: ghc] wip/nfs-locking: Implement build rule for GHCI libraries. (020d528)

[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/020d528e4a296e264bee478f3d89b63d6bb1f0b9/ghc

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

commit 020d528e4a296e264bee478f3d89b63d6bb1f0b9
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Aug 7 02:58:15 2015 +0100

    Implement build rule for GHCI libraries.


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

020d528e4a296e264bee478f3d89b63d6bb1f0b9
 src/Rules/Library.hs              | 53 +++++++++++++++++++--------------------
 src/Settings/Builders/GhcCabal.hs |  1 +
 2 files changed, 27 insertions(+), 27 deletions(-)

diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index 5bd6551..c788edb 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -4,6 +4,7 @@ import Way
 import Base
 import Util
 import Builder
+import Package
 import Switches
 import Expression
 import qualified Target
@@ -12,6 +13,7 @@ import Settings.Util
 import Settings.TargetDirectory
 import Rules.Actions
 import Rules.Resources
+import Data.List
 import Data.Maybe
 
 buildPackageLibrary :: Resources -> StagePackageTarget -> Rules ()
@@ -21,6 +23,7 @@ buildPackageLibrary _ target = do
         path      = targetPath stage pkg
         buildPath = path -/- "build"
 
+    -- TODO: handle dynamic libraries
     matchBuildResult buildPath "a" ?> \a -> do
         liftIO $ removeFiles "." [a]
         cSrcs   <- interpret target $ getPkgDataList CSrcs
@@ -33,31 +36,27 @@ buildPackageLibrary _ target = do
 
         need $ cObjs ++ hsObjs -- this will create split objects if required
 
-        splitObjs <- fmap concat $ forM hsSrcs $ \src -> do
-            let files = buildPath -/- src ++ "_" ++ osuf way ++ "_split/*"
-            getDirectoryFiles "" [files]
-
         split <- interpret target splitObjects
-        let allObjs = if split
-                      then cObjs ++ hsObjs ++ splitObjs
-                      else cObjs ++ hsObjs
-
-        build $ fullTarget target allObjs Ar [a]
-
--- ldRule :: Resources -> StagePackageTarget -> Rules ()
--- ldRule pkg @ (Package name path _ _) todo @ (stage, dist, _) =
---     let pathDist = path </> dist
---         buildDir = pathDist </> "build"
---     in
---     priority 2 $ (buildDir </> "*.o") %> \out -> do
---         cObjs <- pkgCObjects path dist vanilla
---         hObjs <- pkgDepHsObjects path dist vanilla
---         need $ cObjs ++ hObjs
---         run Ld $ ldArgs stage (cObjs ++ hObjs) $ unifyPath out
---         synopsis <- dropWhileEnd isPunctuation <$> showArg (Synopsis pathDist)
---         putColoured Green $ "/--------\n| Successfully built package '"
---             ++ name ++ "' (stage " ++ show stage ++ ")."
---         putColoured Green $ "| Package synopsis: " ++ synopsis ++ "."
---             ++ "\n\\--------"
---         -- Finally, record the argument list
---         need [argListPath argListDir pkg stage]
+        splitObjs <- if split
+            then fmap concat $ forM hsSrcs $ \src -> do
+                let files = buildPath -/- src ++ "_" ++ osuf way ++ "_split/*"
+                getDirectoryFiles "" [files]
+            else return []
+
+        build $ fullTarget target (cObjs ++ hsObjs ++ splitObjs) Ar [a]
+
+        synopsis <- interpret target $ getPkgData Synopsis
+        putSuccess $ "/--------\n| Successfully built package '"
+            ++ pkgName pkg ++ "' (stage " ++ show stage ++ ")."
+        putSuccess $ "| Package synopsis: "
+            ++ dropWhileEnd isPunctuation synopsis ++ "." ++ "\n\\--------"
+
+    -- TODO: this looks fragile as haskell objects can match this rule if their
+    -- names start with "HS" and they are on top of the module hierarchy.
+    (buildPath -/- "HS*.o") %> \o -> do
+        cSrcs   <- interpret target $ getPkgDataList CSrcs
+        modules <- interpret target $ getPkgDataList Modules
+        let hsSrcs = map (replaceEq '.' '/') modules
+            cObjs  = [ buildPath -/- src -<.> "o" | src <-  cSrcs ]
+            hsObjs = [ buildPath -/- src  <.> "o" | src <- hsSrcs ]
+        build $ fullTarget target (cObjs ++ hsObjs) Ld [o]
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 301791d..6969aec 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -39,6 +39,7 @@ cabalArgs = builder GhcCabal ? do
             , with Happy ]
 
 -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
+-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
 libraryArgs :: Args
 libraryArgs = do
     ways   <- getWays