[commit: ghc] wip/nfs-locking: Turn contextDirectory into stageDirectory (241d59a)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:26:13 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