[commit: ghc] wip/nfs-locking: Do not unify paths on each -/- invocation. (6e953f1)

[git at git.haskell.org]

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"