[commit: ghc] wip/nfs-locking: Turn contextDirectory into stageDirectory (241d59a)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:43:38 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/241d59a5f814d5139ca9d6d9bfa0ea127357f505/ghc
>---------------------------------------------------------------
commit 241d59a5f814d5139ca9d6d9bfa0ea127357f505
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sat Oct 29 02:11:59 2016 +0100
Turn contextDirectory into stageDirectory
>---------------------------------------------------------------
241d59a5f814d5139ca9d6d9bfa0ea127357f505
src/GHC.hs | 23 ++++++-----------------
src/Rules/Clean.hs | 6 ++----
src/Rules/Data.hs | 6 +++---
src/Rules/Generate.hs | 2 +-
src/Rules/Register.hs | 2 +-
src/Settings.hs | 2 +-
src/Settings/Paths.hs | 5 ++---
7 files changed, 16 insertions(+), 30 deletions(-)
diff --git a/src/GHC.hs b/src/GHC.hs
index 7cabff5..0312a3e 100644
--- a/src/GHC.hs
+++ b/src/GHC.hs
@@ -9,7 +9,7 @@ module GHC (
parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
terminfo, time, touchy, transformers, unlit, unix, win32, xhtml,
- defaultKnownPackages, programPath, contextDirectory, rtsContext
+ defaultKnownPackages, stageDirectory, rtsContext, programPath
) where
import Base
@@ -91,16 +91,15 @@ xhtml = library "xhtml"
ghcSplit :: FilePath
ghcSplit = "inplace/lib/bin/ghc-split"
--- TODO: The following utils are not included into the build system because
--- they seem to be unused or unrelated to the build process: checkUniques,
--- completion, count_lines, coverity, debugNGC, describe-unexpected, genargs,
--- lndir, mkdirhier, testremove, vagrant
+-- | Relative path to the directory containing build artefacts of a given 'Stage'.
+stageDirectory :: Stage -> FilePath
+stageDirectory = stageString
-- TODO: move to buildRootPath, see #113
-- TODO: simplify, add programInplaceLibPath
-- | The relative path to the program executable
programPath :: Context -> Maybe FilePath
-programPath context at Context {..}
+programPath Context {..}
| package == ghc = Just . inplaceProgram $ "ghc-stage" ++ show (fromEnum stage + 1)
| package `elem` [mkUserGuidePart] =
case stage of Stage0 -> Just . inplaceProgram $ pkgNameString package
@@ -123,19 +122,9 @@ programPath context at Context {..}
| otherwise = Nothing
where
inplaceProgram name = programInplacePath -/- name <.> exe
- installProgram name = pkgPath package -/- contextDirectory context
+ installProgram name = pkgPath package -/- stageDirectory stage
-/- "build/tmp" -/- name <.> exe
-- TODO: Move this elsewhere.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-
--- | GHC build results will be placed into target directories with the
--- following typical structure:
-
--- * @build/@ contains compiled object code
--- * @doc/@ is produced by haddock
--- * @package-data.mk@ contains output of ghc-cabal applied to pkgCabal
-contextDirectory :: Context -> FilePath
-contextDirectory Context {..} = stageString stage
-
diff --git a/src/Rules/Clean.hs b/src/Rules/Clean.hs
index 50edd20..e212048 100644
--- a/src/Rules/Clean.hs
+++ b/src/Rules/Clean.hs
@@ -1,7 +1,6 @@
module Rules.Clean (cleanRules) where
import Base
-import Context
import Package
import Rules.Actions
import Settings
@@ -19,9 +18,8 @@ cleanRules = do
removeDirectory "sdistprep"
putBuild $ "| Remove files generated by ghc-cabal..."
forM_ knownPackages $ \pkg ->
- forM_ [Stage0 ..] $ \stage -> do
- let dir = pkgPath pkg -/- contextDirectory (vanillaContext stage pkg)
- quietly $ removeDirectory dir
+ forM_ [Stage0 ..] $ \stage ->
+ quietly . removeDirectory $ pkgPath pkg -/- stageDirectory stage
putBuild $ "| Remove Hadrian files..."
removeFilesAfter buildRootPath ["//*"]
putSuccess $ "| Done. "
diff --git a/src/Rules/Data.hs b/src/Rules/Data.hs
index cefd2fa..5a4d103 100644
--- a/src/Rules/Data.hs
+++ b/src/Rules/Data.hs
@@ -19,7 +19,7 @@ buildPackageData context at Context {..} = do
let cabalFile = pkgCabalFile package
configure = pkgPath package -/- "configure"
dataFile = pkgDataFile context
- oldPath = pkgPath package -/- contextDirectory context -- TODO: remove, #113
+ oldPath = pkgPath package -/- stageDirectory stage -- TODO: remove, #113
inTreeMk = oldPath -/- takeFileName dataFile -- TODO: remove, #113
inTreeMk %> \mk -> do
@@ -123,7 +123,7 @@ packageCmmSources pkg
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData :: Context -> FilePath -> Action ()
-postProcessPackageData context at Context {..} file = fixFile file fixPackageData
+postProcessPackageData Context {..} file = fixFile file fixPackageData
where
fixPackageData = unlines . map processLine . filter (not . null) . filter ('$' `notElem`) . lines
processLine line = fixKey fixedPrefix ++ suffix
@@ -132,7 +132,7 @@ postProcessPackageData context at Context {..} file = fixFile file fixPackageData
-- Change package/path/targetDir to takeDirectory file
-- This is a temporary hack until we get rid of ghc-cabal
fixedPrefix = takeDirectory file ++ drop len prefix
- len = length (pkgPath package -/- contextDirectory context)
+ len = length (pkgPath package -/- stageDirectory stage)
-- TODO: Remove, see #113.
fixKey :: String -> String
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 698299d..f8cf345 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -133,7 +133,7 @@ generatePackageCode context@(Context stage pkg _) =
need [primopsTxt stage]
build $ Target context GenPrimopCode [primopsTxt stage] [file]
-- TODO: this is temporary hack, get rid of this (#113)
- let oldPath = pkgPath pkg -/- contextDirectory context -/- "build"
+ let oldPath = pkgPath pkg -/- stageDirectory stage -/- "build"
newFile = oldPath ++ (drop (length path) file)
createDirectory $ takeDirectory newFile
liftIO $ IO.copyFile file newFile
diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index d4799e3..6b3e239 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -23,7 +23,7 @@ registerPackage rs context at Context {..} = when (stage <= Stage1) $ do
-- Post-process inplace-pkg-config. TODO: remove, see #113, #148.
let path = buildPath context
- oldPath = pkgPath package -/- contextDirectory context
+ oldPath = pkgPath package -/- stageDirectory stage
pkgConfig = oldPath -/- "inplace-pkg-config"
oldBuildPath = oldPath -/- "build"
fixPkgConf = unlines
diff --git a/src/Settings.hs b/src/Settings.hs
index 0a71c90..3aab9ac 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -35,7 +35,7 @@ getPackagePath :: Expr FilePath
getPackagePath = pkgPath <$> getPackage
getContextDirectory :: Expr FilePath
-getContextDirectory = contextDirectory <$> getContext
+getContextDirectory = stageDirectory <$> getStage
getBuildPath :: Expr FilePath
getBuildPath = buildPath <$> getContext
diff --git a/src/Settings/Paths.hs b/src/Settings/Paths.hs
index 7147264..07c762a 100644
--- a/src/Settings/Paths.hs
+++ b/src/Settings/Paths.hs
@@ -1,5 +1,5 @@
module Settings.Paths (
- contextDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
+ stageDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpObjects, gmpLibraryH,
gmpBuildInfoPath, generatedPath, libffiBuildPath, shakeFilesPath, pkgConfFile,
packageDbDirectory, packageDbStamp, bootPackageConstraints, packageDependencies,
@@ -33,8 +33,7 @@ generatedPath = buildRootPath -/- "generated"
-- | Path to the directory containing build artefacts of a given 'Context'.
buildPath :: Context -> FilePath
-buildPath context at Context {..} =
- buildRootPath -/- contextDirectory context -/- pkgPath package
+buildPath Context {..} = buildRootPath -/- stageDirectory stage -/- pkgPath package
-- | Path to the @package-data.mk@ of a given 'Context'.
pkgDataFile :: Context -> FilePath
More information about the ghc-commits
mailing list