[commit: ghc] wip/nfs-locking: Fix recursive rules error. (8290198)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:54:27 UTC 2017


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

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

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

commit 82901986216e56d42623299aaec8ca7d1bddcdca
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Jan 19 03:45:10 2015 +0000

    Fix recursive rules error.


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

82901986216e56d42623299aaec8ca7d1bddcdca
 src/Package/Base.hs         |  8 +++++---
 src/Package/Compile.hs      | 12 +++++++++---
 src/Package/Data.hs         |  4 +++-
 src/Package/Dependencies.hs |  8 +++++---
 src/Package/Library.hs      |  8 ++++++--
 5 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/src/Package/Base.hs b/src/Package/Base.hs
index 023b001..cf29e59 100644
--- a/src/Package/Base.hs
+++ b/src/Package/Base.hs
@@ -108,8 +108,9 @@ includeGhcArgs path dist =
 pkgHsSources :: FilePath -> FilePath -> Action [FilePath]
 pkgHsSources path dist = do
     let pathDist = path </> dist
+        autogen = pathDist </> "build/autogen"
     dirs <- map (path </>) <$> args (SrcDirs pathDist)
-    findModuleFiles pathDist dirs [".hs", ".lhs"]
+    findModuleFiles pathDist (autogen:dirs) [".hs", ".lhs"]
 
 -- TODO: look for non-{hs,c} objects too
 
@@ -136,11 +137,13 @@ pkgLibHsObjects path dist stage way = do
     let pathDist = path </> dist
         buildDir = unifyPath $ pathDist </> "build"
     split <- splitObjects stage
+    depObjs <- pkgDepHsObjects path dist way
     if split
     then do
+         need depObjs -- Otherwise, split objects may not yet be available
          let suffix = "_" ++ osuf way ++ "_split/*." ++ osuf way
          findModuleFiles pathDist [buildDir] [suffix]
-    else pkgDepHsObjects path dist way
+    else do return depObjs
 
 findModuleFiles :: FilePath -> [FilePath] -> [String] -> Action [FilePath]
 findModuleFiles pathDist directories suffixes = do
@@ -153,7 +156,6 @@ findModuleFiles pathDist directories suffixes = do
                          let dir = takeDirectory file
                          dirExists <- liftIO $ S.doesDirectoryExist dir
                          when dirExists $ return file
-
     files <- getDirectoryFiles "" fileList
     return $ map unifyPath files
 
diff --git a/src/Package/Compile.hs b/src/Package/Compile.hs
index 01659b6..94cf16a 100644
--- a/src/Package/Compile.hs
+++ b/src/Package/Compile.hs
@@ -49,8 +49,10 @@ compileHaskell pkg @ (Package _ path _) todo @ (stage, dist, _) obj way = do
     let buildDir = unifyPath $ path </> dist </> "build"
     -- TODO: keep only vanilla dependencies in 'haskell.deps'
     deps <- args $ DependencyList (buildDir </> "haskell.deps") obj
+    let (srcs, his) = partition ("//*hs" ?==) deps
+        objs = map (-<.> osuf way) his
+    -- Need *.o files instead of *.hi files to avoid recursive rules
     need deps
-    let srcs = filter ("//*hs" ?==) deps
     run (Ghc stage) $ ghcArgs pkg todo way srcs obj
 
 buildRule :: Package -> TodoItem -> Rules ()
@@ -64,15 +66,19 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
 
         (buildDir <//> hiPattern) %> \hi -> do
             let obj = hi -<.> osuf way
-            need [obj]
+            -- TODO: Understand why 'need [obj]' doesn't work, leading to
+            -- recursive rules error. Below is a workaround.
+            -- putColoured Yellow $ "Hi " ++ hi
+            compileHaskell pkg todo obj way
 
         (buildDir <//> oPattern) %> \obj -> do
-            need [argListPath argListDir pkg stage]
             let vanillaObjName = takeFileName obj -<.> "o"
             cDeps <- args $ DependencyList cDepFile vanillaObjName
             if null cDeps
             then compileHaskell pkg todo obj way
             else compileC pkg todo cDeps obj
+            -- Finally, record the argument list
+            need [argListPath argListDir pkg stage]
 
 argListRule :: Package -> TodoItem -> Rules ()
 argListRule pkg todo @ (stage, _, settings) =
diff --git a/src/Package/Data.hs b/src/Package/Data.hs
index e1afee1..6d01ba5 100644
--- a/src/Package/Data.hs
+++ b/src/Package/Data.hs
@@ -121,12 +121,14 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) =
     -- TODO: Is this needed? Also check out Paths_cpsa.hs.
     -- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
     ] &%> \_ -> do
-        need [argListPath argListDir pkg stage, cabal]
+        need [cabal]
         when (doesFileExist $ configure <.> "ac") $ need [configure]
         run GhcCabal $ cabalArgs pkg todo
         when (registerPackage settings) $
             run (GhcPkg stage) $ ghcPkgArgs pkg todo
         postProcessPackageData $ pathDist </> "package-data.mk"
+        -- Finally, record the argument list
+        need [argListPath argListDir pkg stage]
 
 argListRule :: Package -> TodoItem -> Rules ()
 argListRule pkg todo @ (stage, _, _) =
diff --git a/src/Package/Dependencies.hs b/src/Package/Dependencies.hs
index 8675c6f..f87580a 100644
--- a/src/Package/Dependencies.hs
+++ b/src/Package/Dependencies.hs
@@ -61,12 +61,12 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) = do
     let pathDist = path </> dist
         buildDir = pathDist </> "build"
 
-    (buildDir </> "haskell.deps") %> \out -> do
-        need [argListPath argListDir pkg stage]
+    (buildDir </> "haskell.deps") %> \_ -> do
         run (Ghc stage) $ ghcArgs pkg todo
+        -- Finally, record the argument list
+        need [argListPath argListDir pkg stage]
 
     (buildDir </> "c.deps") %> \out -> do
-        need [argListPath argListDir pkg stage]
         srcs <- args $ CSrcs pathDist
         deps <- fmap concat $ forM srcs $ \src -> do
             let srcPath = path </> src
@@ -75,6 +75,8 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) = do
             liftIO $ readFile depFile
         writeFileChanged out deps
         liftIO $ removeFiles buildDir ["*.c.deps"]
+        -- Finally, record the argument list
+        need [argListPath argListDir pkg stage]
 
 argListRule :: Package -> TodoItem -> Rules ()
 argListRule pkg todo @ (stage, _, _) =
diff --git a/src/Package/Library.hs b/src/Package/Library.hs
index c377bc8..6ad029d 100644
--- a/src/Package/Library.hs
+++ b/src/Package/Library.hs
@@ -26,13 +26,15 @@ arRule pkg @ (Package _ path _) todo @ (stage, dist, _) =
         let way = detectWay $ tail $ takeExtension out
         cObjs <- pkgCObjects path dist way
         hsObjs <- pkgDepHsObjects path dist way
-        need $ [argListPath argListDir pkg stage] ++ cObjs ++ hsObjs
+        need $ cObjs ++ hsObjs
         libHsObjs <- pkgLibHsObjects path dist stage way
         liftIO $ removeFiles "." [out]
         -- Splitting argument list into chunks as otherwise Ar chokes up
         maxChunk <- argSizeLimit
         forM_ (chunksOfSize maxChunk $ cObjs ++ libHsObjs) $ \objs -> do
             run Ar $ arArgs objs $ unifyPath out
+        -- Finally, record the argument list
+        need [argListPath argListDir pkg stage]
 
 ldRule :: Package -> TodoItem -> Rules ()
 ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
@@ -42,13 +44,15 @@ ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
     priority 2 $ (buildDir </> "*.o") %> \out -> do
         cObjs <- pkgCObjects path dist vanilla
         hObjs <- pkgDepHsObjects path dist vanilla
-        need $ [argListPath argListDir pkg stage] ++ cObjs ++ hObjs
+        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]
 
 argListRule :: Package -> TodoItem -> Rules ()
 argListRule pkg @ (Package _ path _) todo @ (stage, dist, settings) =



More information about the ghc-commits mailing list