[commit: ghc] wip/nfs-locking: Do not unify paths on each -/- invocation. (6e953f1)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:59:48 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/6e953f10e2c445addda3ade10191c60d90546ef4/ghc
>---------------------------------------------------------------
commit 6e953f10e2c445addda3ade10191c60d90546ef4
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Tue May 10 02:26:26 2016 +0100
Do not unify paths on each -/- invocation.
See #220.
>---------------------------------------------------------------
6e953f10e2c445addda3ade10191c60d90546ef4
src/Base.hs | 4 ++--
src/Oracles/ModuleFiles.hs | 4 +++-
src/Oracles/WindowsPath.hs | 2 +-
src/Rules/Wrappers/Ghc.hs | 2 +-
src/Settings/Builders/GhcCabal.hs | 2 +-
src/Settings/Paths.hs | 21 ++++++++-------------
6 files changed, 16 insertions(+), 19 deletions(-)
diff --git a/src/Base.hs b/src/Base.hs
index 1fcbae7..bd80f47 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -87,9 +87,9 @@ versionToInt s = major * 1000 + minor * 10 + patch
unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx
--- | Combine paths using '</>' and apply 'unifyPath' to the result
+-- | Combine paths with a forward slash regardless of platform.
(-/-) :: FilePath -> FilePath -> FilePath
-a -/- b = unifyPath $ a </> b
+a -/- b = a ++ '/' : b
infixr 6 -/-
diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs
index 652eb9a..897b2e0 100644
--- a/src/Oracles/ModuleFiles.hs
+++ b/src/Oracles/ModuleFiles.hs
@@ -39,7 +39,9 @@ decodeModule = splitFileName . replaceEq '.' '/'
-- > encodeModule "./" "Prelude" == "Prelude"
-- > uncurry encodeModule (decodeModule name) == name
encodeModule :: FilePath -> String -> String
-encodeModule dir file = replaceEq '/' '.' $ dir -/- takeBaseName file
+encodeModule dir file
+ | dir == "./" = replaceEq '/' '.' $ takeBaseName file
+ | otherwise = replaceEq '/' '.' $ dir ++ takeBaseName file
-- | Find the generator for a given 'Context' and a source file. For example:
-- findGenerator (Context Stage1 compiler vanilla)
diff --git a/src/Oracles/WindowsPath.hs b/src/Oracles/WindowsPath.hs
index a0343fb..e252bba 100644
--- a/src/Oracles/WindowsPath.hs
+++ b/src/Oracles/WindowsPath.hs
@@ -25,7 +25,7 @@ fixAbsolutePathOnWindows path = do
then do
let (dir, file) = splitFileName path
winDir <- askOracle $ WindowsPath dir
- return $ winDir -/- file
+ return $ winDir ++ file
else
return path
diff --git a/src/Rules/Wrappers/Ghc.hs b/src/Rules/Wrappers/Ghc.hs
index 343f780..7338450 100644
--- a/src/Rules/Wrappers/Ghc.hs
+++ b/src/Rules/Wrappers/Ghc.hs
@@ -11,4 +11,4 @@ ghcWrapper program = do
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (top -/- program)
- ++ " -B" ++ (top -/- "inplace" -/- "lib") ++ " ${1+\"$@\"}" ]
+ ++ " -B" ++ (top -/- "inplace/lib") ++ " ${1+\"$@\"}" ]
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 9f6c6e2..faeb99d 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -128,7 +128,7 @@ with b = specified b ? do
top <- getTopDirectory
path <- getBuilderPath b
lift $ needBuilder b
- append [withBuilderKey b ++ top -/- path]
+ arg $ withBuilderKey b ++ unifyPath (top </> path)
withStaged :: (Stage -> Builder) -> Args
withStaged sb = with . sb =<< getStage
diff --git a/src/Settings/Paths.hs b/src/Settings/Paths.hs
index 7174a94..288544b 100644
--- a/src/Settings/Paths.hs
+++ b/src/Settings/Paths.hs
@@ -12,11 +12,6 @@ import GHC
import Oracles.PackageData
import Settings.User
--- A more efficient version of '-/-' which assumes that given FilePaths have
--- already been unified. See #218. TODO: Switch to 'newtype FilePath'.
-(~/~) :: FilePath -> FilePath -> FilePath
-x ~/~ y = x ++ '/' : y
-
shakeFilesPath :: FilePath
shakeFilesPath = buildRootPath -/- "hadrian/shake-files"
@@ -29,17 +24,17 @@ packageDependencies = shakeFilesPath -/- "package-dependencies"
-- | Path to the directory containing build artefacts of a given 'Context'.
buildPath :: Context -> FilePath
buildPath context at Context {..} =
- buildRootPath ~/~ contextDirectory context ~/~ pkgPath package
+ buildRootPath -/- contextDirectory context -/- pkgPath package
-- | Path to the @package-data.mk@ of a given 'Context'.
pkgDataFile :: Context -> FilePath
-pkgDataFile context = buildPath context ~/~ "package-data.mk"
+pkgDataFile context = buildPath context -/- "package-data.mk"
-- | Path to the haddock file of a given 'Context', e.g.:
-- ".build/stage1/libraries/array/doc/html/array/array.haddock".
pkgHaddockFile :: Context -> FilePath
pkgHaddockFile context at Context {..} =
- buildPath context ~/~ "doc/html" ~/~ name ~/~ name <.> "haddock"
+ buildPath context -/- "doc/html" -/- name -/- name <.> "haddock"
where name = pkgNameString package
-- | Path to the library file of a given 'Context', e.g.:
@@ -65,11 +60,11 @@ pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context prefix suffix = do
let path = buildPath context
componentId <- pkgData $ ComponentId path
- return $ path ~/~ prefix ++ componentId ++ suffix
+ return $ path -/- prefix ++ componentId ++ suffix
-- | Build directory for in-tree GMP library.
gmpBuildPath :: FilePath
-gmpBuildPath = buildRootPath ~/~ "stage1/gmp"
+gmpBuildPath = buildRootPath -/- "stage1/gmp"
-- | Path to the GMP library.
gmpLibrary :: FilePath
@@ -85,7 +80,7 @@ gmpObjects = gmpBuildPath -/- "objs"
-- | Path to the GMP library buildinfo file.
gmpBuildInfoPath :: FilePath
-gmpBuildInfoPath = pkgPath integerGmp ~/~ "integer-gmp.buildinfo"
+gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo"
-- | Build directory for in-tree libffi library.
libffiBuildPath :: FilePath
@@ -95,11 +90,11 @@ libffiBuildPath = buildRootPath -/- "stage1/libffi"
-- StageN, N > 0, share the same packageDbDirectory
-- | Path to package database directory of a given 'Stage'.
packageDbDirectory :: Stage -> FilePath
-packageDbDirectory Stage0 = buildRootPath ~/~ "stage0/bootstrapping.conf"
+packageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
packageDbDirectory _ = "inplace/lib/package.conf.d"
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile context at Context {..} = do
componentId <- pkgData . ComponentId $ buildPath context
- return $ packageDbDirectory stage ~/~ componentId <.> "conf"
+ return $ packageDbDirectory stage -/- componentId <.> "conf"
More information about the ghc-commits
mailing list