[commit: ghc] wip/nfs-locking: Fix builder dependencies on generated files (#363) (d9c97e8)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 01:21:00 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/d9c97e8f96f482fe7d84e01d61682e82e1edad59/ghc
>---------------------------------------------------------------
commit d9c97e8f96f482fe7d84e01d61682e82e1edad59
Author: Zhen Zhang <izgzhen at gmail.com>
Date: Fri Jul 21 01:14:15 2017 +0800
Fix builder dependencies on generated files (#363)
>---------------------------------------------------------------
d9c97e8f96f482fe7d84e01d61682e82e1edad59
src/Rules.hs | 1 -
src/Rules/Generate.hs | 14 +-------------
src/Rules/Program.hs | 4 +++-
src/Rules/Test.hs | 3 ++-
src/Settings/Builders/GhcCabal.hs | 4 +++-
src/Settings/Builders/Hsc2Hs.hs | 7 ++-----
src/Settings/Path.hs | 17 ++++++++++++++++-
src/Util.hs | 1 +
8 files changed, 28 insertions(+), 23 deletions(-)
diff --git a/src/Rules.hs b/src/Rules.hs
index 69fcaee..359d3e9 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -29,7 +29,6 @@ allStages = [minBound ..]
-- or Stage1Only targets
topLevelTargets :: Rules ()
topLevelTargets = action $ do
- need $ Rules.Generate.inplaceLibCopyTargets
let libraryPackages = filter isLibrary (knownPackages \\ [rts, libffi])
need =<< if stage1Only
then do
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 3507027..80eca91 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,6 +1,6 @@
module Rules.Generate (
isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
- copyRules, includesDependencies, generatedDependencies, inplaceLibCopyTargets
+ copyRules, includesDependencies, generatedDependencies
) where
import Base
@@ -24,18 +24,6 @@ import Target
import UserSettings
import Util
--- | Files that need to be copied over to inplace/lib
--- ref: ghc/ghc.mk:142
--- ref: driver/ghc.mk
--- ref: utils/hsc2hs/ghc.mk:35
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
- [ "ghc-usage.txt"
- , "ghci-usage.txt"
- , "platformConstants"
- , "settings"
- , "template-hsc.h" ]
-
primopsSource :: FilePath
primopsSource = "compiler/prelude/primops.txt.pp"
diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs
index 846c694..710829b 100644
--- a/src/Rules/Program.hs
+++ b/src/Rules/Program.hs
@@ -14,7 +14,7 @@ import Oracles.Path (topDirectory)
import Rules.Wrappers (WrappedBinary(..), Wrapper, inplaceWrappers)
import Settings
import Settings.Path (buildPath, inplaceLibBinPath, rtsContext, objectPath,
- inplaceLibPath, inplaceBinPath)
+ inplaceLibPath, inplaceBinPath, inplaceLibCopyTargets)
import Target
import UserSettings
import Util
@@ -28,6 +28,8 @@ buildProgram rs context at Context {..} = when (isProgram package) $ do
buildPath context -/- programName context <.> exe %>
buildBinaryAndWrapper rs context
+ when (package == ghc) $ want inplaceLibCopyTargets
+
-- Rules for programs built in install directories
when (stage == Stage0 || package == ghc) $ do
-- Some binaries in inplace/bin are wrapped
diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs
index fc059ab..93e97c2 100644
--- a/src/Rules/Test.hs
+++ b/src/Rules/Test.hs
@@ -10,6 +10,7 @@ import Oracles.Config.Flag
import Oracles.Config.Setting
import Oracles.Path
import Settings
+import Settings.Path (inplaceLibCopyTargets)
import Target
import Util
@@ -17,7 +18,7 @@ import Util
testRules :: Rules ()
testRules = do
"validate" ~> do
- need $ Rules.Generate.inplaceLibCopyTargets
+ need inplaceLibCopyTargets
needBuilder $ Ghc CompileHs Stage2
needBuilder $ GhcPkg Update Stage1
needBuilder Hpc
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 18816e1..33a7b99 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -4,7 +4,7 @@ module Settings.Builders.GhcCabal (
import Context
import Flavour
-import Settings.Builders.Common
+import Settings.Builders.Common hiding (package)
import Util
ghcCabalBuilderArgs :: Args
@@ -12,6 +12,8 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
verbosity <- lift $ getVerbosity
top <- getTopDirectory
context <- getContext
+ when (package context /= deriveConstants) $
+ lift (need inplaceLibCopyTargets)
mconcat [ arg "configure"
, arg =<< getPackagePath
, arg $ top -/- buildPath context
diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs
index ba98654..a9ec9c5 100644
--- a/src/Settings/Builders/Hsc2Hs.hs
+++ b/src/Settings/Builders/Hsc2Hs.hs
@@ -1,9 +1,7 @@
module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where
import Settings.Builders.Common
-
-templateHsc :: FilePath
-templateHsc = "inplace/lib/template-hsc.h"
+import Settings.Path (templateHscPath)
hsc2hsBuilderArgs :: Args
hsc2hsBuilderArgs = builder Hsc2Hs ? do
@@ -20,7 +18,6 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
version <- if stage == Stage0
then lift ghcCanonVersion
else getSetting ProjectVersionInt
- lift $ need [templateHsc]
mconcat [ arg $ "--cc=" ++ ccPath
, arg $ "--ld=" ++ ccPath
, notM windowsHost ? arg "--cross-safe"
@@ -33,7 +30,7 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
, notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1")
, notStage0 ? arg ("--cflag=-D" ++ tOs ++ "_HOST_OS=1" )
, arg $ "--cflag=-D__GLASGOW_HASKELL__=" ++ version
- , arg $ "--template=" ++ top -/- templateHsc
+ , arg $ "--template=" ++ top -/- templateHscPath
, arg $ "-I" ++ top -/- "inplace/lib/include/"
, arg =<< getInput
, arg "-o", arg =<< getOutput ]
diff --git a/src/Settings/Path.hs b/src/Settings/Path.hs
index 0be1838..c8153bf 100644
--- a/src/Settings/Path.hs
+++ b/src/Settings/Path.hs
@@ -6,7 +6,7 @@ module Settings.Path (
pkgConfFile, packageDbStamp, bootPackageConstraints, packageDependencies,
objectPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
inplaceInstallPath, autogenPath, pkgInplaceConfig, ghcSplitPath, stripCmdPath,
- pkgSetupConfigFile
+ pkgSetupConfigFile, inplaceLibCopyTargets, templateHscPath
) where
import Base
@@ -214,3 +214,18 @@ stripCmdPath = do
"arm-unknown-linux" ->
return ":" -- HACK: from the make-based system, see the ref above
_ -> return "strip"
+
+-- | Files that need to be copied over to inplace/lib
+-- ref: ghc/ghc.mk:142
+-- ref: driver/ghc.mk
+-- ref: utils/hsc2hs/ghc.mk:35
+inplaceLibCopyTargets :: [FilePath]
+inplaceLibCopyTargets = map (inplaceLibPath -/-)
+ [ "ghc-usage.txt"
+ , "ghci-usage.txt"
+ , "platformConstants"
+ , "settings"
+ , "template-hsc.h" ]
+
+templateHscPath :: FilePath
+templateHscPath = "inplace/lib/template-hsc.h"
diff --git a/src/Util.hs b/src/Util.hs
index 37743c0..7ea567e 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -22,6 +22,7 @@ import Oracles.Path
import Oracles.Config.Setting
import Settings
import Settings.Builders.Ar
+import Settings.Path
import Target
import UserSettings
More information about the ghc-commits
mailing list