Add dependencies on argument lists.

src/Package.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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