[commit: ghc] wip/nfs-locking: Fix recursive rules error. (8290198)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:08:33 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