[commit: ghc] wip/nfs-locking: Add support for hs-boot files. (6344510)

[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/6344510f3cda3097bf77d62a021e70049407c9ac/ghc

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

commit 6344510f3cda3097bf77d62a021e70049407c9ac
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Aug 7 22:33:20 2015 +0100

    Add support for hs-boot files.


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

6344510f3cda3097bf77d62a021e70049407c9ac
 src/Rules/Compile.hs | 32 +++++++++++++++++++++++++-------
 src/Rules/Library.hs |  7 +++----
 2 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 223f9b2..35c9755 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -10,7 +10,6 @@ import Oracles.DependencyList
 import Settings.TargetDirectory
 import Rules.Actions
 import Rules.Resources
-import Data.Maybe
 
 compilePackage :: Resources -> StagePackageTarget -> Rules ()
 compilePackage _ target = do
@@ -21,14 +20,16 @@ compilePackage _ target = do
         cDepsFile = buildPath -/- "c.deps"
         hDepsFile = buildPath -/- "haskell.deps"
 
-    matchBuildResult buildPath "hi" ?> \hi -> do
-        let way = fromJust . detectWay $ hi -- fromJust is safe
-        need [hi -<.> osuf way]
+    matchBuildResult buildPath "hi" ?> \hi ->
+        need [ hi -<.> osuf (detectWay hi) ]
+
+    matchBuildResult buildPath "hi-boot" ?> \hiboot ->
+        need [ hiboot -<.> obootsuf (detectWay hiboot) ]
 
     matchBuildResult buildPath "o" ?> \obj -> do
-        let way        = fromJust . detectWay $ obj -- fromJust is safe
-            vanillaObj = takeFileName obj -<.> "o"
-        cDeps <- dependencyList cDepsFile vanillaObj
+        let way  = detectWay obj
+            cObj = takeFileName obj -<.> "o"
+        cDeps <- dependencyList cDepsFile cObj
         hDeps <- dependencyList hDepsFile obj
         let hSrcDeps = filter ("//*hs" ?==) hDeps
 
@@ -43,3 +44,20 @@ compilePackage _ target = do
         if null cDeps
         then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
         else build $ fullTarget        target cDeps    (Gcc stage)     [obj]
+
+    matchBuildResult buildPath "o-boot" ?> \obj -> do
+        let way = detectWay obj
+        hDeps <- dependencyList hDepsFile obj
+        let hSrcDeps = filter ("//*hs-boot" ?==) hDeps
+
+        when (null hDeps) $
+            putError $ "Cannot determine sources for '" ++ obj ++ "'."
+
+        need hDeps
+        build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
+
+-- TODO: add support for -dyno
+-- $1/$2/build/%.$$($3_o-bootsuf) : $1/$4/%.hs-boot
+--     $$(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 $$@)))
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index fe0c72d..8fd9b0b 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -14,7 +14,6 @@ import Settings.TargetDirectory
 import Rules.Actions
 import Rules.Resources
 import Data.List
-import Data.Maybe
 
 buildPackageLibrary :: Resources -> StagePackageTarget -> Rules ()
 buildPackageLibrary _ target = do
@@ -29,7 +28,7 @@ buildPackageLibrary _ target = do
         cSrcs   <- interpret target $ getPkgDataList CSrcs
         modules <- interpret target $ getPkgDataList Modules
 
-        let way   = fromJust . detectWay $ a -- fromJust is safe
+        let way   = detectWay a
             hSrcs = map (replaceEq '.' '/') modules
             cObjs = [ buildPath -/- src -<.> osuf way | src <- cSrcs ]
             hObjs = [ buildPath -/- src  <.> osuf way | src <- hSrcs ]
@@ -54,11 +53,11 @@ buildPackageLibrary _ target = do
 
     -- 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.
-    priority 2 $ (buildPath -/- "HS*.o") %> \o -> do
+    priority 2 $ (buildPath -/- "HS*.o") %> \obj -> do
         cSrcs   <- interpret target $ getPkgDataList CSrcs
         modules <- interpret target $ getPkgDataList Modules
         let hSrcs = map (replaceEq '.' '/') modules
             cObjs = [ buildPath -/- src -<.> "o" | src <- cSrcs ]
             hObjs = [ buildPath -/- src  <.> "o" | src <- hSrcs ]
         need $ cObjs ++ hObjs
-        build $ fullTarget target (cObjs ++ hObjs) Ld [o]
+        build $ fullTarget target (cObjs ++ hObjs) Ld [obj]