[commit: ghc] wip/nfs-locking: Avoid using interpretDiff, use simpler interpret instead. (327b06e)

[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/327b06e578a4194368020152bd90b8eb4193dd7a/ghc

>---------------------------------------------------------------

commit 327b06e578a4194368020152bd90b8eb4193dd7a
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Aug 2 15:02:23 2015 +0100

    Avoid using interpretDiff, use simpler interpret instead.


>---------------------------------------------------------------

327b06e578a4194368020152bd90b8eb4193dd7a
 src/Expression.hs         | 10 +++++-----
 src/Oracles/ArgsHash.hs   |  2 +-
 src/Rules.hs              |  3 +--
 src/Rules/Actions.hs      |  2 +-
 src/Rules/Cabal.hs        |  4 ++--
 src/Rules/Data.hs         |  8 ++++----
 src/Rules/Dependencies.hs |  2 +-
 src/Settings/Args.hs      |  7 ++++---
 src/Settings/Util.hs      |  2 +-
 9 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/Expression.hs b/src/Expression.hs
index 6ec6ef4..ee8e8f3 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -8,7 +8,7 @@ module Expression (
     Args, Ways, Packages,
     apply, append, appendM, remove,
     appendSub, appendSubD, filterSub, removeSub,
-    interpret, interpretExpr,
+    interpret, interpretDiff,
     getStage, getPackage, getBuilder, getFiles, getFile,
     getDependencies, getDependency, getWay,
     stage, package, builder, stagedBuilder, file, way
@@ -141,16 +141,16 @@ removeSub :: String -> [String] -> Args
 removeSub prefix xs = filterSub prefix (`notElem` xs)
 
 -- Interpret a given expression in a given environment
-interpretExpr :: Target -> Expr a -> Action a
-interpretExpr = flip runReaderT
+interpret :: Target -> Expr a -> Action a
+interpret = flip runReaderT
 
 -- Extract an expression from a difference expression
 fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
 fromDiffExpr = fmap (($ mempty) . fromDiff)
 
 -- Interpret a given difference expression in a given environment
-interpret :: Monoid a => Target -> DiffExpr a -> Action a
-interpret target = interpretExpr target . fromDiffExpr
+interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
+interpretDiff target = interpret target . fromDiffExpr
 
 -- Convenient getters for target parameters
 getStage :: Expr Stage
diff --git a/src/Oracles/ArgsHash.hs b/src/Oracles/ArgsHash.hs
index 1972638..ca0aa6c 100644
--- a/src/Oracles/ArgsHash.hs
+++ b/src/Oracles/ArgsHash.hs
@@ -22,5 +22,5 @@ askArgsHash = askOracle . ArgsHashKey
 -- Oracle for storing per-target argument list hashes
 argsHashOracle :: Rules ()
 argsHashOracle = do
-    addOracle $ \(ArgsHashKey target) -> hash <$> interpret target args
+    addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
     return ()
diff --git a/src/Rules.hs b/src/Rules.hs
index e651325..be109f8 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -15,11 +15,10 @@ import Settings.Packages
 import Settings.TargetDirectory
 
 -- generateTargets needs package-data.mk files of all target packages
--- TODO: make interpretDiff total
 generateTargets :: Rules ()
 generateTargets = action $ do
     targets <- fmap concat . forM [Stage0 ..] $ \stage -> do
-        pkgs <- interpret (stageTarget stage) packages
+        pkgs <- interpret (stageTarget stage) getPackages
         fmap concat . forM pkgs $ \pkg -> return
             [ targetPath stage pkg -/- "build/haskell.deps"
             , targetPath stage pkg -/- "build/c.deps" ]
diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index 1940a4a..d96157c 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -21,7 +21,7 @@ buildWithResources rs target = do
     needBuilder builder
     need deps
     path    <- builderPath builder
-    argList <- interpret target args
+    argList <- interpret target getArgs
     -- The line below forces the rule to be rerun if the args hash has changed
     argsHash <- askArgsHash target
     withResources rs $ do
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
index 48db356..55d909d 100644
--- a/src/Rules/Cabal.hs
+++ b/src/Rules/Cabal.hs
@@ -16,7 +16,7 @@ cabalRules :: Rules ()
 cabalRules = do
     -- Cache boot package constraints (to be used in cabalArgs)
     bootPackageConstraints %> \file -> do
-        pkgs <- interpret (stageTarget Stage0) packages
+        pkgs <- interpret (stageTarget Stage0) getPackages
         constraints <- forM (sort pkgs) $ \pkg -> do
             let cabal = pkgCabalPath pkg
             need [cabal]
@@ -29,7 +29,7 @@ cabalRules = do
 
     -- Cache package dependencies
     packageDependencies %> \file -> do
-        pkgs <- interpret (stageTarget Stage1) packages
+        pkgs <- interpret (stageTarget Stage1) getPackages
         pkgDeps <- forM (sort pkgs) $ \pkg -> do
             let cabal = pkgCabalPath pkg
             need [cabal]
diff --git a/src/Rules/Data.hs b/src/Rules/Data.hs
index 762115c..8f365e8 100644
--- a/src/Rules/Data.hs
+++ b/src/Rules/Data.hs
@@ -40,16 +40,16 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
 
             -- We configure packages in the order of their dependencies
             deps <- packageDeps pkg
-            pkgs <- interpret target packages
-            let cmp pkg = compare (pkgName pkg)
-                depPkgs = intersectOrd cmp (sort pkgs) deps
+            pkgs <- interpret target getPackages
+            let cmp pkg name = compare (pkgName pkg) name
+                depPkgs      = intersectOrd cmp (sort pkgs) deps
             need [ targetPath stage p -/- "package-data.mk" | p <- depPkgs ]
 
             buildWithResources [(ghcCabal, 1)] $
                 fullTarget target [cabal] GhcCabal files
 
             -- TODO: find out of ghc-cabal can be concurrent with ghc-pkg
-            whenM (interpretExpr target registerPackage) .
+            whenM (interpret target registerPackage) .
                 buildWithResources [(ghcPkg, 1)] $
                 fullTarget target [cabal] (GhcPkg stage) files
 
diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs
index 7fab8cf..bee85c6 100644
--- a/src/Rules/Dependencies.hs
+++ b/src/Rules/Dependencies.hs
@@ -32,5 +32,5 @@ buildPackageDependencies _ target =
             writeFileChanged file (concat deps)
 
         (buildPath -/- "haskell.deps") %> \file -> do
-            srcs <- interpretExpr target getHsSources
+            srcs <- interpret target getHsSources
             build $ fullTarget target srcs (GhcM stage) [file]
diff --git a/src/Settings/Args.hs b/src/Settings/Args.hs
index d698017..4d4dd17 100644
--- a/src/Settings/Args.hs
+++ b/src/Settings/Args.hs
@@ -1,6 +1,4 @@
-module Settings.Args (
-    args
-    ) where
+module Settings.Args (args, getArgs) where
 
 import Expression
 import Settings.User
@@ -12,6 +10,9 @@ import Settings.GhcCabal
 args :: Args
 args = defaultArgs <> userArgs
 
+getArgs :: Expr [String]
+getArgs = fromDiffExpr args
+
 -- TODO: add all other settings
 -- TODO: add src-hc-args = -H32m -O
 -- TODO: GhcStage2HcOpts=-O2 unless GhcUnregisterised
diff --git a/src/Settings/Util.hs b/src/Settings/Util.hs
index d2daa0b..d04a12a 100644
--- a/src/Settings/Util.hs
+++ b/src/Settings/Util.hs
@@ -85,7 +85,7 @@ getHsSources = do
     (foundSources, missingSources) <- findModuleFiles dirs "*hs"
 
     -- Generated source files live in buildPath and have extension "hs"
-    let generatedSources = map (\f -> buildPath -/- f <.> "hs") missingSources
+    let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
 
     return $ foundSources ++ generatedSources