Skip to content
GitLab
Commit 50b8c2ff authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add dependencies on argument lists.

parent 1b0bfa66
Hide whitespace changes
Inline Side-by-side
src/Package.hs
View file @ 50b8c2ff
......@@ -10,21 +10,20 @@ import Package.Dependencies
-- These are the packages we build:
packages :: [Package]
packages = [ libraryPackage "array" Stage1 defaultSettings
, libraryPackage "bin-package-db" Stage0 defaultSettings
, libraryPackage "bin-package-db" Stage1 defaultSettings
, libraryPackage "binary" Stage1 defaultSettings
, libraryPackage "deepseq" Stage1 defaultSettings
, libraryPackage "Cabal/Cabal" Stage1 defaultSettings
, libraryPackage "containers" Stage1 defaultSettings
, libraryPackage "filepath" Stage1 defaultSettings
, libraryPackage "hoopl" Stage1 defaultSettings
, libraryPackage "hpc" Stage1 defaultSettings
, libraryPackage "parallel" Stage1 defaultSettings
, libraryPackage "pretty" Stage1 defaultSettings
, libraryPackage "stm" Stage1 defaultSettings
, libraryPackage "template-haskell" Stage1 defaultSettings
, libraryPackage "transformers" Stage1 defaultSettings ]
packages = [ libraryPackage "array" [ Stage1] defaultSettings
, libraryPackage "bin-package-db" [Stage0, Stage1] defaultSettings
, libraryPackage "binary" [Stage0, Stage1] defaultSettings
, libraryPackage "deepseq" [ Stage1] defaultSettings
, libraryPackage "Cabal/Cabal" [ Stage1] defaultSettings
, libraryPackage "containers" [ Stage1] defaultSettings
, libraryPackage "filepath" [ Stage1] defaultSettings
, libraryPackage "hoopl" [Stage0, Stage1] defaultSettings
, libraryPackage "hpc" [Stage0, Stage1] defaultSettings
, libraryPackage "parallel" [ Stage1] defaultSettings
, libraryPackage "pretty" [ Stage1] defaultSettings
, libraryPackage "stm" [ Stage1] defaultSettings
, libraryPackage "template-haskell" [ Stage1] defaultSettings
, libraryPackage "transformers" [Stage0, Stage1] defaultSettings ]
-- Rule buildPackageX is defined in module Package.X
buildPackage :: Package -> TodoItem -> Rules ()
......
src/Package/Base.hs
View file @ 50b8c2ff
......@@ -10,7 +10,8 @@ module Package.Base (
bootPkgConstraints,
pathArgs, packageArgs, includeArgs, pkgHsSources,
pkgDepObjects, pkgLibObjects,
argSizeLimit
argSizeLimit,
sourceDependecies, argList, argListPath
) where
import Base
......@@ -46,16 +47,18 @@ data Package = Package
pkgTodo :: [TodoItem] -- [(Stage1, "dist-install", defaultSettings)]
}
libraryPackage :: String -> Stage -> (Stage -> Settings) -> Package
libraryPackage name stage settings =
libraryPackage :: String -> [Stage] -> (Stage -> Settings) -> Package
libraryPackage name stages settings =
Package
name
(toStandard $ "libraries" </> name)
[(
stage,
if stage == Stage0 then "dist-boot" else "dist-install",
settings stage
)]
[
( stage
, if stage == Stage0 then "dist-boot" else "dist-install"
, settings stage
)
| stage <- stages
]
commonCcArgs :: Args
commonCcArgs = when Validating $ arg ["-Werror", "-Wall"]
......@@ -141,12 +144,13 @@ pkgLibObjects path dist stage way = do
findModuleFiles :: FilePath -> [FilePath] -> [String] -> Action [FilePath]
findModuleFiles pkgData directories suffixes = do
mods <- arg (Modules pkgData)
files <- getDirectoryFiles "" $ do
dir <- directories
modPath <- map (replaceEq '.' pathSeparator) mods
suffix <- suffixes
return $ dir </> modPath ++ suffix
modPaths <- map (replaceEq '.' pathSeparator) <$> arg (Modules pkgData)
fileList <- forM directories $ \dir ->
forM modPaths $ \modPath ->
forM suffixes $ \suffix -> do
let file = dir </> modPath ++ suffix
when (doesDirectoryExist $ dropFileName file) $ return file
files <- getDirectoryFiles "" $ concat $ concat fileList
return $ map (toStandard . normaliseEx) files
-- The argument list has a limited size on Windows. Since Windows 7 the limit
......@@ -159,3 +163,30 @@ argSizeLimit = do
return $ if windows
then 31000
else 1048576 -- surely, 1MB should be enough?
-- List of source files, which need to be tracked by the build system
-- to make sure the argument lists have not changed.
sourceDependecies :: [FilePath]
sourceDependecies = [ "shake/src/Package/Base.hs"
, "shake/src/Oracles/Base.hs"
, "shake/src/Oracles/Flag.hs"
, "shake/src/Oracles/Option.hs"
, "shake/src/Oracles/Builder.hs"
, "shake/src/Oracles/PackageData.hs"
, "shake/src/Ways.hs"
, "shake/src/Util.hs"
, "shake/src/Oracles.hs"
]
-- Convert Builder's argument list to a String
argList :: Builder -> Args -> String -> Action String
argList builder args comment = do
list <- args
return $ show builder ++ " arguments"
++ if comment == "" then "" else ("(" ++ comment ++ ")")
++ ":\n" ++ concatMap (\s -> " " ++ s ++ "\n") list
-- Path to argument list for a given Package/Stage combination
argListPath :: FilePath -> Package -> Stage -> FilePath
argListPath dir (Package name _ _) stage =
dir </> takeBaseName name ++ " (stage " ++ show stage ++ ")" <.> "txt"
src/Package/Compile.hs
View file @ 50b8c2ff
......@@ -4,56 +4,56 @@ module Package.Compile (buildPackageCompile) where
import Package.Base
import Development.Shake.Util
{- "inplace/bin/ghc-stage1.exe" -hisuf hi -osuf o -hcsuf hc
-static -H32m -O
-this-package-key deeps_FT5iVCELxOr62eHY0nbvnU -hide-all-packages
-i -ilibraries/deepseq/. -ilibraries/deepseq/dist-install/build
-ilibraries/deepseq/dist-install/build/autogen
-Ilibraries/deepseq/dist-install/build
-Ilibraries/deepseq/dist-install/build/autogen
-Ilibraries/deepseq/.
-optP-include -optPlibraries/deepseq/dist-install/build/autogen/cabal_macros.h
-package-key array_3w0nMK0JfaFJPpLFn2yWAJ
-package-key base_469rOtLAqwTGFEOGWxSUiQ
-package-key ghcpr_FgrV6cgh2JHBlbcx1OSlwt
-Wall -XHaskell2010 -O2 -no-user-package-db -rtsopts
-odir libraries/deepseq/dist-install/build
-hidir libraries/deepseq/dist-install/build
-stubdir libraries/deepseq/dist-install/build
-split-objs
-c libraries/deepseq/./Control/DeepSeq.hs
-o libraries/deepseq/dist-install/build/Control/DeepSeq.o -}
argListDir :: FilePath
argListDir = "shake/arg/buildPackageCompile"
suffixArgs :: Way -> Args
suffixArgs way = arg ["-hisuf", hisuf way]
<> arg [ "-osuf", osuf way]
<> arg ["-hcsuf", hcsuf way]
buildPackageCompile :: Package -> TodoItem -> Rules ()
buildPackageCompile (Package name path _) (stage, dist, settings) =
ghcArgs :: Package -> TodoItem -> Way -> [FilePath] -> FilePath -> Args
ghcArgs (Package _ path _) (stage, dist, _) way srcs result =
let buildDir = toStandard $ path </> dist </> "build"
pkgData = path </> dist </> "package-data.mk"
in suffixArgs way
<> wayHcArgs way
<> arg SrcHcOpts
<> packageArgs stage pkgData
<> includeArgs path dist
<> concatArgs ["-optP"] (CppOpts pkgData)
<> arg (HsOpts pkgData)
-- TODO: now we have both -O and -O2
-- <> arg ["-O2"]
<> productArgs ["-odir", "-hidir", "-stubdir"] buildDir
<> when (splitObjects stage) (arg "-split-objs")
<> arg ("-c":srcs)
<> arg ["-o", result]
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
let buildDir = toStandard $ path </> dist </> "build"
depFile = buildDir </> takeBaseName name <.> "m"
in
[buildDir <//> "*o", buildDir <//> "*hi"] &%> \[out, _] -> do
let way = detectWay $ tail $ takeExtension out
need ["shake/src/Package/Compile.hs"]
need [depFile]
need [argListPath argListDir pkg stage, depFile]
depContents <- parseMakefile <$> (liftIO $ readFile depFile)
let deps = concat $ snd $ unzip $ filter ((== out) . fst) depContents
srcs = filter ("//*hs" ?==) deps -- TODO: handle *.c sources
need deps
terseRun (Ghc stage) $ suffixArgs way
<> wayHcArgs way
<> arg SrcHcOpts
<> packageArgs stage pkgData
<> includeArgs path dist
<> concatArgs ["-optP"] (CppOpts pkgData)
<> arg (HsOpts pkgData)
-- TODO: now we have both -O and -O2
-- <> arg ["-O2"]
<> productArgs ["-odir", "-hidir", "-stubdir"] buildDir
<> when (splitObjects stage) (arg "-split-objs")
<> arg ("-c":srcs)
<> arg ["-o", toStandard out]
terseRun (Ghc stage) $ ghcArgs pkg todo way srcs (toStandard out)
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, settings) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Compile.hs"] ++ sourceDependecies
ways' <- ways settings
ghcList <- forM ways' $ \way ->
argList (Ghc stage)
(ghcArgs pkg todo way ["input.hs"] $ "output" <.> osuf way)
$ "way '" ++ tag way ++ "'"
writeFileChanged out $ unlines ghcList
buildPackageCompile :: Package -> TodoItem -> Rules ()
buildPackageCompile = argListRule <> buildRule
src/Package/Data.hs
View file @ 50b8c2ff
......@@ -3,6 +3,9 @@ module Package.Data (buildPackageData) where
import Package.Base
argListDir :: FilePath
argListDir = "shake/arg/buildPackageData"
libraryArgs :: [Way] -> Args
libraryArgs ways =
argEnable False "library-for-ghci" -- TODO: why always disable?
......@@ -55,32 +58,38 @@ postProcessPackageData file = do
where
(prefix, suffix) = break (== '=') line
buildPackageData :: Package -> TodoItem -> Rules ()
buildPackageData (Package name path _) (stage, dist, settings) =
cabalArgs :: Package -> TodoItem -> Args
cabalArgs (Package _ path _) (stage, dist, settings) =
arg ["configure", path, dist]
-- this is a positional argument, hence:
-- * if it is empty, we need to emit one empty string argument
-- * otherwise, we must collapse it into one space-separated string
<> arg (unwords <$> customDllArgs settings)
<> with (Ghc stage) -- TODO: used limited to max stage1 GHC
<> with (GhcPkg stage)
<> customConfArgs settings
<> (libraryArgs =<< ways settings)
<> when (specified HsColour) (with HsColour)
<> configureArgs stage settings
<> when (stage == Stage0) bootPkgConstraints
<> with Gcc
<> when (stage /= Stage0) (with Ld)
<> with Ar
<> with Alex
<> with Happy -- TODO: reorder with's
ghcPkgArgs :: Package -> TodoItem -> Args
ghcPkgArgs (Package _ path _) (stage, dist, _) =
arg ["update", "--force"]
<> (stage == Stage0) <?>
arg "--package-db=libraries/bootstrapping.conf"
<> arg (toStandard $ path </> dist </> "inplace-pkg-config")
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) =
let pathDist = path </> dist
configure = path </> "configure"
cabal = path </> takeBaseName name <.> "cabal"
cabalArgs = arg ["configure", path, dist]
-- this is a positional argument, hence:
-- * if it is empty, we need to emit one empty string argument
-- * otherwise, we must collapse it into one space-separated string
<> arg (unwords <$> customDllArgs settings)
<> with (Ghc stage) -- TODO: used limited to max stage1 GHC
<> with (GhcPkg stage)
<> customConfArgs settings
<> (libraryArgs =<< ways settings)
<> when (specified HsColour) (with HsColour)
<> configureArgs stage settings
<> when (stage == Stage0) bootPkgConstraints
<> with Gcc
<> when (stage /= Stage0) (with Ld)
<> with Ar
<> with Alex
<> with Happy -- TODO: reorder with's
ghcPkgArgs = arg ["update", "--force"]
<> (stage == Stage0) <?>
arg "--package-db=libraries/bootstrapping.conf"
<> arg (toStandard $ pathDist </> "inplace-pkg-config")
in
(pathDist </>) <$>
[ "package-data.mk"
......@@ -91,9 +100,20 @@ buildPackageData (Package name path _) (stage, dist, settings) =
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
] &%> \_ -> do
need ["shake/src/Package/Data.hs"]
need [cabal]
need [argListPath argListDir pkg stage, cabal]
when (doesFileExist $ configure <.> "ac") $ need [configure]
terseRun GhcCabal cabalArgs
when (registerPackage settings) $ terseRun (GhcPkg stage) ghcPkgArgs
terseRun GhcCabal $ cabalArgs pkg todo
when (registerPackage settings) $
terseRun (GhcPkg stage) $ ghcPkgArgs pkg todo
postProcessPackageData $ pathDist </> "package-data.mk"
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, _) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Data.hs"] ++ sourceDependecies
cabalList <- argList GhcCabal (cabalArgs pkg todo) ""
ghcPkgList <- argList (GhcPkg stage) (ghcPkgArgs pkg todo) ""
writeFileChanged out $ cabalList ++ "\n" ++ ghcPkgList
buildPackageData :: Package -> TodoItem -> Rules ()
buildPackageData = argListRule <> buildRule
src/Package/Dependencies.hs
View file @ 50b8c2ff
......@@ -3,24 +3,43 @@ module Package.Dependencies (buildPackageDependencies) where
import Package.Base
buildPackageDependencies :: Package -> TodoItem -> Rules ()
buildPackageDependencies (Package name path _) (stage, dist, settings) =
argListDir :: FilePath
argListDir = "shake/arg/buildPackageDependencies"
ghcArgs :: Package -> TodoItem -> Args
ghcArgs (Package name path _) (stage, dist, settings) =
let buildDir = toStandard $ path </> dist </> "build"
pkgData = path </> dist </> "package-data.mk"
depFile = buildDir </> takeBaseName name <.> "m"
in arg "-M"
<> packageArgs stage pkgData
<> includeArgs path dist
<> concatArgs ["-optP"] (CppOpts pkgData)
<> productArgs ["-odir", "-stubdir", "-hidir"] buildDir
<> arg ["-dep-makefile", depFile <.> "new"]
<> productArgs "-dep-suffix" (map wayPrefix <$> ways settings)
<> arg (HsOpts pkgData)
<> arg (pkgHsSources path dist)
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) =
let buildDir = toStandard $ path </> dist </> "build"
in
(buildDir </> takeBaseName name <.> "m") %> \out -> do
need ["shake/src/Package/Dependencies.hs"]
terseRun (Ghc stage) $ arg "-M"
<> packageArgs stage pkgData
<> includeArgs path dist
<> concatArgs ["-optP"] (CppOpts pkgData)
<> productArgs ["-odir", "-stubdir", "-hidir"] buildDir
<> arg ["-dep-makefile", toStandard $ out <.> "new"]
<> productArgs "-dep-suffix" (map wayPrefix <$> ways settings)
<> arg (HsOpts pkgData)
<> arg (pkgHsSources path dist)
need [argListPath argListDir pkg stage]
terseRun (Ghc stage) $ ghcArgs pkg todo
-- Avoid rebuilding dependecies of out if it hasn't changed:
-- Note: cannot use copyFileChanged as it depends on the source file
deps <- liftIO $ readFile $ out <.> "new"
writeFileChanged out deps
removeFilesAfter "." [out <.> "new"]
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, _) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Dependencies.hs"] ++ sourceDependecies
ghcList <- argList (Ghc stage) (ghcArgs pkg todo) ""
writeFileChanged out ghcList
buildPackageDependencies :: Package -> TodoItem -> Rules ()
buildPackageDependencies = argListRule <> buildRule
src/Package/Library.hs
View file @ 50b8c2ff
......@@ -3,41 +3,67 @@ module Package.Library (buildPackageLibrary) where
import Package.Base
argListDir :: FilePath
argListDir = "shake/arg/buildPackageLibrary"
arArgs :: [FilePath] -> FilePath -> Args
arArgs objs result = arg $ [ arg "q"
, arg result
, arg objs ]
arRule :: Package -> TodoItem -> Rules ()
arRule (Package _ path _) (stage, dist, _) =
arRule pkg @ (Package _ path _) todo @ (stage, dist, _) =
let buildDir = path </> dist </> "build"
in
(buildDir <//> "*a") %> \out -> do
let way = detectWay $ tail $ takeExtension out
need ["shake/src/Package/Library.hs"]
depObjs <- pkgDepObjects path dist way
need depObjs
need $ [argListPath argListDir pkg stage] ++ depObjs
libObjs <- pkgLibObjects path dist stage way
liftIO $ removeFiles "." [out]
-- Splitting argument list into chunks as otherwise Ar chokes up
maxChunk <- argSizeLimit
forM_ (chunksOfSize maxChunk libObjs) $ \os -> do
terseRun Ar [ arg "q"
, arg $ toStandard out
, arg os ]
terseRun Ar $ arArgs os $ toStandard out
ldArgs :: Package -> TodoItem -> FilePath -> Args
ldArgs (Package _ path _) (stage, dist, _) result = do
depObjs <- pkgDepObjects path dist vanilla
need depObjs
arg $ [arg (ConfLdLinkerArgs stage)
, arg "-r"
, arg "-o"
, arg result
, arg depObjs ]
ldRule :: Package -> TodoItem -> Rules ()
ldRule (Package name path _) (stage, dist, _) =
ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
let buildDir = path </> dist </> "build"
pkgData = path </> dist </> "package-data.mk"
in
priority 2 $ (buildDir </> "*.o") %> \out -> do
need ["shake/src/Package/Library.hs"]
depObjs <- pkgDepObjects path dist vanilla
need depObjs
terseRun Ld [ arg (ConfLdLinkerArgs stage)
, arg "-r"
, arg "-o"
, arg $ toStandard out
, arg depObjs ]
need [argListPath argListDir pkg stage]
terseRun Ld $ ldArgs pkg todo $ toStandard out
synopsis <- unwords <$> arg (Synopsis pkgData)
putNormal $ "/--------\nSuccessfully built package " ++ name ++ "."
putNormal $ "Package synopsis: " ++ synopsis ++ ".\n\\--------"
putColoured Vivid Green $ "/--------\n| Successfully built package "
++ name ++ " (stage " ++ show stage ++ ")."
putColoured Vivid Green $ "| Package synopsis: " ++ synopsis ++ "."
++ "\n\\--------"
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg @ (Package _ path _) todo @ (stage, dist, settings) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Library.hs"] ++ sourceDependecies
ways' <- ways settings
ldList <- argList Ld (ldArgs pkg todo "output.o") ""
arList <- forM ways' $ \way -> do
depObjs <- pkgDepObjects path dist way
need depObjs
libObjs <- pkgLibObjects path dist stage way
extension <- libsuf way
argList Ar (arArgs libObjs $ "output" <.> extension)
$ "way '" ++ tag way ++ "'"
writeFileChanged out $ unlines $ [ldList] ++ arList
buildPackageLibrary :: Package -> TodoItem -> Rules ()
buildPackageLibrary = arRule <> ldRule
buildPackageLibrary = argListRule <> arRule <> ldRule
Supports Markdown
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