Commit 82901986 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Fix recursive rules error.

parent a1819f6a
......@@ -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
......
......@@ -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) =
......
......@@ -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, _, _) =
......
......@@ -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, _, _) =
......
......@@ -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) =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment