summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrey Mokhov <andrey.mokhov@gmail.com>2019-02-14 14:29:50 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-02-20 09:59:16 -0500
commit1dad4fc27ea128a11ba0077f459494c2a1ca0d5c (patch)
treec5b569c56435e699c03fca5ad08cf03cb8b21b80
parent908b4b8659713f0b7a1704ce33c7fa30e3e0ffc3 (diff)
downloadhaskell-1dad4fc27ea128a11ba0077f459494c2a1ca0d5c.tar.gz
Hadrian: Fix untracked dependencies
This is a preparation for #16295: https://ghc.haskell.org/trac/ghc/ticket/16295 This commit mostly focuses on getting rid of untracked dependencies, which prevent Shake's new `--shared` feature from appropriately caching build rules. There are three different solutions to untracked dependencies: * Track them! This is the obvious and the best approach, but in some situations we cannot use it, for example, because a build rule creates files whose names are not known statically and hence cannot be specified as the rule's outputs. * Use Shake's `produces` to record outputs dynamically, within the rule. * Use Shake's `historyDisable` to disable caching for a particular build rule. We currently use this approach only for `ghc-pkg` which mutates the package database and the file `package.cache`. These two tickets are fixed as the result: Ticket #16271: ​https://ghc.haskell.org/trac/ghc/ticket/16271 Ticket #16272: ​https://ghc.haskell.org/trac/ghc/ticket/16272 (this one is fixed only partially: we correctly record the dependency, but we still copy files into the RTS build tree).
-rw-r--r--hadrian/hadrian.cabal2
-rw-r--r--hadrian/src/Base.hs22
-rw-r--r--hadrian/src/Builder.hs14
-rw-r--r--hadrian/src/Context.hs16
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal.hs3
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal/Parse.hs58
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal/Type.hs57
-rw-r--r--hadrian/src/Hadrian/Oracles/Cabal/Rules.hs7
-rw-r--r--hadrian/src/Oracles/ModuleFiles.hs9
-rw-r--r--hadrian/src/Packages.hs33
-rw-r--r--hadrian/src/Rules.hs4
-rw-r--r--hadrian/src/Rules/Compile.hs125
-rw-r--r--hadrian/src/Rules/Configure.hs2
-rw-r--r--hadrian/src/Rules/Dependencies.hs36
-rw-r--r--hadrian/src/Rules/Documentation.hs17
-rw-r--r--hadrian/src/Rules/Generate.hs65
-rw-r--r--hadrian/src/Rules/Gmp.hs49
-rw-r--r--hadrian/src/Rules/Libffi.hs59
-rw-r--r--hadrian/src/Rules/Register.hs90
-rwxr-xr-xhadrian/src/Settings.hs14
-rw-r--r--hadrian/src/Settings/Builders/Ghc.hs4
-rw-r--r--hadrian/src/Settings/Builders/GhcPkg.hs3
-rw-r--r--hadrian/src/Settings/Builders/Hsc2Hs.hs4
-rw-r--r--hadrian/src/Settings/Default.hs9
-rw-r--r--utils/touchy/touchy.cabal2
25 files changed, 369 insertions, 335 deletions
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 6a4fff1321..56c68aa0c3 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -124,7 +124,7 @@ executable hadrian
, mtl == 2.2.*
, parsec >= 3.1 && < 3.2
, QuickCheck >= 2.6 && < 2.13
- , shake >= 0.16.4
+ , shake >= 0.17.5
, transformers >= 0.4 && < 0.6
, unordered-containers >= 0.2.1 && < 0.3
build-tools: alex >= 3.1
diff --git a/hadrian/src/Base.hs b/hadrian/src/Base.hs
index 77eec0a48a..7949fcf4b2 100644
--- a/hadrian/src/Base.hs
+++ b/hadrian/src/Base.hs
@@ -24,7 +24,8 @@ module Base (
-- * Paths
hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath,
- ghcDeps, haddockDeps, relativePackageDbPath, packageDbPath, packageDbStamp,
+ ghcDeps, includesDependencies, haddockDeps, relativePackageDbPath,
+ packageDbPath, packageDbStamp,
ghcSplitPath
) where
@@ -106,15 +107,20 @@ stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin")
stageLibPath :: Stage -> Action FilePath
stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib")
--- | Files the `ghc` binary depends on
+-- | Files the GHC binary depends on.
ghcDeps :: Stage -> Action [FilePath]
ghcDeps stage = mapM (\f -> stageLibPath stage <&> (-/- f))
- [ "ghc-usage.txt"
- , "ghci-usage.txt"
- , "llvm-targets"
- , "llvm-passes"
- , "platformConstants"
- , "settings" ]
+ [ "ghc-usage.txt"
+ , "ghci-usage.txt"
+ , "llvm-targets"
+ , "llvm-passes"
+ , "platformConstants"
+ , "settings" ]
+
+includesDependencies :: Action [FilePath]
+includesDependencies = do
+ path <- generatedPath
+ return $ (path -/-) <$> [ "ghcautoconf.h", "ghcplatform.h", "ghcversion.h" ]
-- | Files the `haddock` binary depends on
haddockDeps :: Stage -> Action [FilePath]
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index d09af9942e..02edb199d3 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -75,13 +75,13 @@ instance Hashable ConfigurationInfo
instance NFData ConfigurationInfo
-- TODO: Do we really need all these modes? Why do we need 'Dependencies'? We
--- can extract dependencies using the Cabal library.
+-- can extract dependencies using the Cabal library. Note: we used to also have
+-- the @Init@ mode for initialising a new package database but we've deleted it.
-- | 'GhcPkg' can initialise a package database and register packages in it.
-data GhcPkgMode = Init -- ^ Initialize a new database.
- | Update -- ^ Update a package.
- | Copy -- ^ Copy a package from one database to another.
- | Unregister -- ^ Unregister a package.
+data GhcPkgMode = Copy -- ^ Copy a package from one database to another.
| Dependencies -- ^ Compute package dependencies.
+ | Unregister -- ^ Unregister a package.
+ | Update -- ^ Update a package.
deriving (Eq, Generic, Show)
instance Binary GhcPkgMode
@@ -173,16 +173,18 @@ instance H.Builder Builder where
Autoreconf dir -> return [dir -/- "configure.ac"]
Configure dir -> return [dir -/- "configure"]
- Ghc _ Stage0 -> return []
+ Ghc _ Stage0 -> generatedGhcDependencies Stage0
Ghc _ stage -> do
root <- buildRoot
win <- windowsHost
touchyPath <- programPath (vanillaContext Stage0 touchy)
unlitPath <- builderPath Unlit
ghcdeps <- ghcDeps stage
+ ghcgens <- generatedGhcDependencies stage
return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects
, unlitPath ]
++ ghcdeps
+ ++ ghcgens
++ [ touchyPath | win ]
Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index 7943e6dfce..f8a07d7263 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -8,7 +8,7 @@ module Context (
-- * Paths
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,
- contextPath, getContextPath, libDir, libPath, distDir
+ contextPath, getContextPath, libPath, distDir
) where
import Base
@@ -43,12 +43,9 @@ getWay = way <$> getContext
getStagedSettingList :: (Stage -> SettingList) -> Args Context b
getStagedSettingList f = getSettingList . f =<< getStage
-libDir :: Context -> FilePath
-libDir Context {..} = stageString stage -/- "lib"
-
-- | Path to the directory containg the final artifact in a given 'Context'.
libPath :: Context -> Action FilePath
-libPath context = buildRoot <&> (-/- libDir context)
+libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))
-- | Get the directory name for binary distribution files
-- @<arch>-<os>-ghc-<version>@.
@@ -70,16 +67,11 @@ pkgFile context@Context {..} prefix suffix = do
-- | Path to inplace package configuration file of a given 'Context'.
pkgInplaceConfig :: Context -> Action FilePath
-pkgInplaceConfig context = do
- path <- contextPath context
- return $ path -/- "inplace-pkg-config"
+pkgInplaceConfig context = contextPath context <&> (-/- "inplace-pkg-config")
--- TODO: Add a @Rules FilePath@ alternative.
-- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath
-pkgSetupConfigFile context = do
- path <- contextPath context
- return $ path -/- "setup-config"
+pkgSetupConfigFile context = contextPath context <&> (-/- "setup-config")
-- | Path to the haddock file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
diff --git a/hadrian/src/Hadrian/Haskell/Cabal.hs b/hadrian/src/Hadrian/Haskell/Cabal.hs
index 91de7b2bb2..de4dd18de6 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal.hs
@@ -11,8 +11,7 @@
-----------------------------------------------------------------------------
module Hadrian.Haskell.Cabal (
pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies,
- pkgGenericDescription,
- cabalArchString, cabalOsString,
+ pkgGenericDescription, cabalArchString, cabalOsString,
) where
import Development.Shake
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
index 8df343b423..d53aabd5e1 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
@@ -10,8 +10,8 @@
-- Extracting Haskell package metadata stored in Cabal files.
-----------------------------------------------------------------------------
module Hadrian.Haskell.Cabal.Parse (
- ContextData (..), parsePackageData, resolveContextData, parseCabalPkgId,
- configurePackage, copyPackage, registerPackage
+ parsePackageData, resolveContextData, parseCabalPkgId, configurePackage,
+ buildAutogenFiles, copyPackage, registerPackage
) where
import Data.Bifunctor
@@ -107,8 +107,7 @@ biModules pd = go [ comp | comp@(bi,_,_) <-
-- the package the 'Context' points to.
configurePackage :: Context -> Action ()
configurePackage context@Context {..} = do
- putLoud $ "| Configure package " ++ quote (pkgName package)
-
+ putProgressInfo $ "| Configure package " ++ quote (pkgName package)
gpd <- pkgGenericDescription package
depPkgs <- packageDependencies <$> readPackageData package
@@ -145,11 +144,18 @@ configurePackage context@Context {..} = do
liftIO $ C.defaultMainWithHooksNoReadArgs hooks gpd
(argList ++ ["--flags=" ++ unwords flagList, v])
+ dir <- Context.buildPath context
+ files <- liftIO $ getDirectoryFilesIO "." [ dir -/- "include" <//> "*"
+ , dir -/- "*.buildinfo"
+ , dir -/- "lib" <//> "*"
+ , dir -/- "config.*" ]
+ produces files
+
-- | Copy the 'Package' of a given 'Context' into the package database
-- corresponding to the 'Stage' of the 'Context'.
copyPackage :: Context -> Action ()
copyPackage context@Context {..} = do
- putLoud $ "| Copy package " ++ quote (pkgName package)
+ putProgressInfo $ "| Copy package " ++ quote (pkgName package)
gpd <- pkgGenericDescription package
ctxPath <- Context.contextPath context
pkgDbPath <- packageDbPath stage
@@ -161,7 +167,7 @@ copyPackage context@Context {..} = do
-- | Register the 'Package' of a given 'Context' into the package database.
registerPackage :: Context -> Action ()
registerPackage context@Context {..} = do
- putLoud $ "| Register package " ++ quote (pkgName package)
+ putProgressInfo $ "| Register package " ++ quote (pkgName package)
ctxPath <- Context.contextPath context
gpd <- pkgGenericDescription package
verbosity <- getVerbosity
@@ -199,19 +205,13 @@ resolveContextData context@Context {..} = do
(const True) platform (C.compilerInfo compiler) [] gpd
cPath <- Context.contextPath context
- need [cPath -/- "setup-config"]
-
lbi <- liftIO $ C.getPersistBuildConfig cPath
- -- TODO: Move this into its own rule for @build/autogen/cabal_macros.h@, and
- -- @build/autogen/Path_*.hs@ and 'need' these files here.
- -- Create the @cabal_macros.h@, ...
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
-- from the local build info @lbi@.
pdi <- liftIO $ getHookedBuildInfo [pkgPath package, cPath -/- "build"]
let pd' = C.updatePackageDescription pdi pd
lbi' = lbi { C.localPkgDescr = pd' }
- liftIO $ C.initialBuildSteps cPath pd' lbi' C.silent
-- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations
-- See: https://github.com/snowleopard/hadrian/issues/548
@@ -272,16 +272,30 @@ resolveContextData context@Context {..} = do
++ C.languageToFlags (C.compiler lbi') (C.defaultLanguage buildInfo)
++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions buildInfo)
++ C.programOverrideArgs ghcProg
- , asmOpts = C.asmOptions buildInfo
- , ccOpts = C.ccOptions buildInfo
- , cmmOpts = C.cmmOptions buildInfo
- , cppOpts = C.cppOptions buildInfo
- , ldOpts = C.ldOptions buildInfo
- , depIncludeDirs = forDeps Installed.includeDirs
- , depCcOpts = forDeps Installed.ccOptions
- , depLdOpts = forDeps Installed.ldOptions
- , buildGhciLib = C.withGHCiLib lbi'
- , frameworks = C.frameworks buildInfo }
+ , asmOpts = C.asmOptions buildInfo
+ , ccOpts = C.ccOptions buildInfo
+ , cmmOpts = C.cmmOptions buildInfo
+ , cppOpts = C.cppOptions buildInfo
+ , ldOpts = C.ldOptions buildInfo
+ , depIncludeDirs = forDeps Installed.includeDirs
+ , depCcOpts = forDeps Installed.ccOptions
+ , depLdOpts = forDeps Installed.ldOptions
+ , buildGhciLib = C.withGHCiLib lbi'
+ , frameworks = C.frameworks buildInfo
+ , packageDescription = pd' }
+
+-- | Build autogenerated files @autogen/cabal_macros.h@ and @autogen/Paths_*.hs@.
+buildAutogenFiles :: Context -> Action ()
+buildAutogenFiles context = do
+ cPath <- Context.contextPath context
+ setupConfig <- pkgSetupConfigFile context
+ need [setupConfig] -- This triggers 'configurePackage'
+ pd <- packageDescription <$> readContextData context
+ -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
+ -- from the local build info @lbi@.
+ liftIO $ do
+ lbi <- C.getPersistBuildConfig cPath
+ C.initialBuildSteps cPath pd (lbi { C.localPkgDescr = pd }) C.silent
-- | Look for a @.buildinfo@ in all of the specified directories, stopping on
-- the first one we find.
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
index b2a7002d6c..2b5d51a719 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
@@ -38,33 +38,34 @@ data PackageData = PackageData
-- See 'PackageData' for metadata that can be obtained without resolving package
-- configuration flags and conditionals.
data ContextData = ContextData
- { dependencies :: [PackageName]
- , componentId :: String
- , mainIs :: Maybe (String, FilePath) -- ("Main", filepath)
- , modules :: [String]
- , otherModules :: [String]
- , srcDirs :: [String]
- , depIds :: [String]
- , depNames :: [String]
- , includeDirs :: [String]
- , includes :: [String]
- , installIncludes :: [String]
- , extraLibs :: [String]
- , extraLibDirs :: [String]
- , asmSrcs :: [String]
- , cSrcs :: [String]
- , cmmSrcs :: [String]
- , hcOpts :: [String]
- , asmOpts :: [String]
- , ccOpts :: [String]
- , cmmOpts :: [String]
- , cppOpts :: [String]
- , ldOpts :: [String]
- , depIncludeDirs :: [String]
- , depCcOpts :: [String]
- , depLdOpts :: [String]
- , buildGhciLib :: Bool
- , frameworks :: [String]
+ { dependencies :: [PackageName]
+ , componentId :: String
+ , mainIs :: Maybe (String, FilePath) -- ("Main", filepath)
+ , modules :: [String]
+ , otherModules :: [String]
+ , srcDirs :: [String]
+ , depIds :: [String]
+ , depNames :: [String]
+ , includeDirs :: [String]
+ , includes :: [String]
+ , installIncludes :: [String]
+ , extraLibs :: [String]
+ , extraLibDirs :: [String]
+ , asmSrcs :: [String]
+ , cSrcs :: [String]
+ , cmmSrcs :: [String]
+ , hcOpts :: [String]
+ , asmOpts :: [String]
+ , ccOpts :: [String]
+ , cmmOpts :: [String]
+ , cppOpts :: [String]
+ , ldOpts :: [String]
+ , depIncludeDirs :: [String]
+ , depCcOpts :: [String]
+ , depLdOpts :: [String]
+ , buildGhciLib :: Bool
+ , frameworks :: [String]
+ , packageDescription :: PackageDescription
} deriving (Eq, Generic, Show, Typeable)
instance Binary PackageData
@@ -72,5 +73,5 @@ instance Hashable PackageData where hashWithSalt salt = hashWithSalt salt . show
instance NFData PackageData
instance Binary ContextData
-instance Hashable ContextData
+instance Hashable ContextData where hashWithSalt salt = hashWithSalt salt . show
instance NFData ContextData
diff --git a/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs b/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
index dcda3704a8..b7f0f93526 100644
--- a/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
+++ b/hadrian/src/Hadrian/Oracles/Cabal/Rules.hs
@@ -19,7 +19,7 @@ import Distribution.Simple.Program.Db
import Distribution.Verbosity
import Builder
-import Context.Type
+import Context
import Hadrian.Haskell.Cabal.Parse
import Hadrian.Oracles.Cabal.Type
import Hadrian.Package
@@ -46,6 +46,11 @@ cabalOracle = do
putLoud $ "| ContextData oracle: resolving data for "
++ quote (pkgName package) ++ " (" ++ show stage
++ ", " ++ show way ++ ")..."
+ -- Calling 'need' on @setup-config@ triggers 'configurePackage'. Why
+ -- this indirection? Going via @setup-config@ allows us to cache the
+ -- configuration step, i.e. not to repeat it if it's already been done.
+ setupConfig <- pkgSetupConfigFile context
+ need [setupConfig]
resolveContextData context
void $ addOracleCache $ \(PackageConfigurationKey (pkg, stage)) -> do
diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs
index 1e508c0090..d2f0299563 100644
--- a/hadrian/src/Oracles/ModuleFiles.hs
+++ b/hadrian/src/Oracles/ModuleFiles.hs
@@ -81,7 +81,9 @@ findGenerator Context {..} file = do
-- | Find all Haskell source files for a given 'Context'.
hsSources :: Context -> Action [FilePath]
hsSources context = do
- let modFile (m, Nothing ) = generatedFile context m
+ let modFile (m, Nothing)
+ | "Paths_" `isPrefixOf` m = autogenFile context m
+ | otherwise = generatedFile context m
modFile (m, Just file )
| takeExtension file `elem` haskellExtensions = return file
| otherwise = generatedFile context m
@@ -99,6 +101,10 @@ hsObjects context = do
generatedFile :: Context -> ModuleName -> Action FilePath
generatedFile context moduleName = buildPath context <&> (-/- moduleSource moduleName)
+-- | Generated module files live in the 'Context' specific build directory.
+autogenFile :: Context -> ModuleName -> Action FilePath
+autogenFile context modName = autogenPath context <&> (-/- moduleSource modName)
+
-- | Turn a module name (e.g. @Data.Functor@) to a path (e.g. @Data/Functor.hs@).
moduleSource :: ModuleName -> FilePath
moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
@@ -125,6 +131,7 @@ moduleFilesOracle :: Rules ()
moduleFilesOracle = void $ do
void . addOracleCache $ \(ModuleFiles (stage, package)) -> do
let context = vanillaContext stage package
+ ensureConfigured context
srcDirs <- interpretInContext context (getContextData PD.srcDirs)
mainIs <- interpretInContext context (getContextData PD.mainIs)
let removeMain = case mainIs of
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index 02dc134387..8d2aef1c7b 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -12,7 +12,8 @@ module Packages (
-- * Package information
programName, nonHsMainPackage, autogenPath, programPath, timeoutPath,
- rtsContext, rtsBuildPath, libffiContext, libffiBuildPath, libffiLibraryName
+ rtsContext, rtsBuildPath, libffiContext, libffiBuildPath, libffiLibraryName,
+ generatedGhcDependencies, ensureConfigured
) where
import Hadrian.Package
@@ -145,7 +146,7 @@ programName Context {..} = do
(Profiling, "-prof"),
(Dynamic, "-dyn")
]]
- _ -> pkgName package
+ _ -> pkgName package
-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
@@ -170,8 +171,8 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
nonHsMainPackage :: Package -> Bool
nonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit])
--- TODO: Can we extract this information from Cabal files?
--- | Path to the @autogen@ directory generated when configuring a package.
+-- TODO: Combine this with 'programName'.
+-- | Path to the @autogen@ directory generated by 'buildAutogenFiles'.
autogenPath :: Context -> Action FilePath
autogenPath context@Context {..}
| isLibrary package = autogen "build"
@@ -181,6 +182,16 @@ autogenPath context@Context {..}
where
autogen dir = contextPath context <&> (-/- dir -/- "autogen")
+-- | Make sure a given context has already been fully configured. The
+-- implementation simply calls 'need' on the context's @autogen/cabal_macros.h@
+-- file, which triggers 'configurePackage' and 'buildAutogenFiles'. Why this
+-- indirection? Going via @autogen/cabal_macros.h@ allows us to cache the
+-- configuration steps, i.e. not to repeat them if they have already been done.
+ensureConfigured :: Context -> Action ()
+ensureConfigured context = do
+ autogen <- autogenPath context
+ need [autogen -/- "cabal_macros.h"]
+
-- | RTS is considered a Stage1 package. This determines RTS build directory.
rtsContext :: Stage -> Context
rtsContext stage = vanillaContext stage rts
@@ -189,9 +200,8 @@ rtsContext stage = vanillaContext stage rts
rtsBuildPath :: Stage -> Action FilePath
rtsBuildPath stage = buildPath (rtsContext stage)
--- | Build directory for libffi
--- This probably doesn't need to be stage dependent but it is for
--- consistency for now.
+-- | Build directory for @libffi@. This probably doesn't need to be stage
+-- dependent but it is for consistency for now.
libffiContext :: Stage -> Context
libffiContext stage = vanillaContext stage libffi
@@ -208,3 +218,12 @@ libffiLibraryName = do
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
+
+-- | Generated header files required by GHC in runtime.
+generatedGhcDependencies :: Stage -> Action [FilePath]
+generatedGhcDependencies stage = do
+ let context = vanillaContext stage compiler
+ bh <- buildPath context <&> (-/- "ghc_boot_platform.h")
+ ch <- contextPath context <&> (-/- "ghc_boot_platform.h")
+ is <- includesDependencies
+ return $ is ++ [bh, ch]
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index f634f22828..c5be5a7ff9 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -82,8 +82,8 @@ packageTargets includeGhciLib stage pkg = do
ways <- interpretInContext context pkgWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways
more <- libraryTargets includeGhciLib context
- setup <- pkgSetupConfigFile context
- return $ [setup] ++ libs ++ more
+ setupConfig <- pkgSetupConfigFile context
+ return $ [setupConfig] ++ libs ++ more
else do -- The only target of a program package is the executable.
prgContext <- programContext stage pkg
prgPath <- programPath prgContext
diff --git a/hadrian/src/Rules/Compile.hs b/hadrian/src/Rules/Compile.hs
index 74570a1556..0a84e67e90 100644
--- a/hadrian/src/Rules/Compile.hs
+++ b/hadrian/src/Rules/Compile.hs
@@ -8,7 +8,6 @@ import Context
import Expression
import Rules.Generate
import Settings
-import Settings.Default
import Target
import Utilities
@@ -19,7 +18,6 @@ import qualified Text.Parsec as Parsec
compilePackage :: [(Resource, Int)] -> Rules ()
compilePackage rs = do
root <- buildRootRules
-
-- We match all file paths that look like:
-- <root>/...stuffs.../build/...stuffs.../<something>.<suffix>
--
@@ -32,13 +30,11 @@ compilePackage rs = do
-- and parse the information we need (stage, package path, ...) from
-- the path and figure out the suitable way to produce that object file.
objectFilesUnder root |%> \path -> do
- obj <- parsePath (parseBuildObject root) "<object file path parser>" path
- compileObject rs path obj
-
+ obj <- parsePath (parseBuildObject root) "<object file path parser>" path
+ compileObject rs path obj
where
objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat)
- | pat <- extensionPats
- ]
+ | pat <- extensionPats ]
exts = [ "o", "hi", "o-boot", "hi-boot" ]
patternsFor e = [ "." ++ e, ".*_" ++ e ]
@@ -73,8 +69,7 @@ compilePackage rs = do
-}
-- | Non Haskell source languages that we compile to get object files.
-data SourceLang = Asm | C | Cmm
- deriving (Eq, Show)
+data SourceLang = Asm | C | Cmm deriving (Eq, Show)
parseSourceLang :: Parsec.Parsec String () SourceLang
parseSourceLang = Parsec.choice
@@ -96,16 +91,15 @@ data NonHsObject = NonHsObject SourceLang Basename Way
parseNonHsObject :: Parsec.Parsec String () NonHsObject
parseNonHsObject = do
- lang <- parseSourceLang
- _ <- Parsec.char '/'
- file <- parseBasename
- way <- parseWayPrefix vanilla
- _ <- Parsec.char 'o'
- return (NonHsObject lang file way)
+ lang <- parseSourceLang
+ _ <- Parsec.char '/'
+ file <- parseBasename
+ way <- parseWayPrefix vanilla
+ _ <- Parsec.char 'o'
+ return (NonHsObject lang file way)
-- | > <o|hi|o-boot|hi-boot>
-data SuffixType = O | Hi | OBoot | HiBoot
- deriving (Eq, Show)
+data SuffixType = O | Hi | OBoot | HiBoot deriving (Eq, Show)
parseSuffixType :: Parsec.Parsec String () SuffixType
parseSuffixType = Parsec.choice
@@ -120,31 +114,26 @@ parseSuffixType = Parsec.choice
]
-- | > <way prefix>_<o|hi|o-boot|hi-boot>
-data Extension = Extension Way SuffixType
- deriving (Eq, Show)
+data Extension = Extension Way SuffixType deriving (Eq, Show)
parseExtension :: Parsec.Parsec String () Extension
-parseExtension =
- Extension <$> parseWayPrefix vanilla <*> parseSuffixType
+parseExtension = Extension <$> parseWayPrefix vanilla <*> parseSuffixType
-- | > <file>.<way prefix>_<o|hi|o-boot|hi-boot>
-data HsObject = HsObject Basename Extension
- deriving (Eq, Show)
+data HsObject = HsObject Basename Extension deriving (Eq, Show)
parseHsObject :: Parsec.Parsec String () HsObject
parseHsObject = do
- file <- parseBasename
- ext <- parseExtension
- return (HsObject file ext)
+ file <- parseBasename
+ ext <- parseExtension
+ return (HsObject file ext)
-data Object = Hs HsObject | NonHs NonHsObject
- deriving (Eq, Show)
+data Object = Hs HsObject | NonHs NonHsObject deriving (Eq, Show)
parseObject :: Parsec.Parsec String () Object
parseObject = Parsec.choice
- [ NonHs <$> parseNonHsObject
- , Hs <$> parseHsObject
- ]
+ [ NonHs <$> parseNonHsObject
+ , Hs <$> parseHsObject ]
-- * Toplevel parsers
@@ -153,50 +142,38 @@ parseBuildObject root = parseBuildPath root parseObject
-- * Getting contexts from objects
-objectContext :: BuildPath Object -> Action Context
-objectContext (BuildPath _ stage pkgpath obj) = do
- pkg <- getPackageFromPath pkgpath
- return (Context stage pkg way)
-
- where way = case obj of
- NonHs (NonHsObject _lang _file w) -> w
- Hs (HsObject _file (Extension w _suf)) -> w
-
- getPackageFromPath path = do
- pkgs <- getPackages
- case filter (\p -> pkgPath p == path) pkgs of
- (p:_) -> return p
- _ -> error $ "couldn't find a package with path: " ++ path
-
- getPackages = do
- pkgs <- stagePackages stage
- testPkgs <- testsuitePackages
- return $ pkgs ++ if stage == Stage1 then testPkgs else []
+objectContext :: BuildPath Object -> Context
+objectContext (BuildPath _ stage pkgPath obj) =
+ Context stage (unsafeFindPackageByPath pkgPath) way
+ where
+ way = case obj of
+ NonHs (NonHsObject _lang _file w) -> w
+ Hs (HsObject _file (Extension w _suf)) -> w
-- * Building an object
compileHsObject
- :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()
+ :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()
compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj =
case hsobj of
- HsObject _basename (Extension _way Hi) ->
- need [ change "hi" "o" objpath ]
- HsObject _basename (Extension _way HiBoot) ->
- need [ change "hi-boot" "o-boot" objpath ]
- HsObject _basename (Extension _way _suf) -> do
- ctx <- objectContext b
- ctxPath <- contextPath ctx
- (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
- need (src:deps)
- needLibrary =<< contextDependencies ctx
- buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
-
- where change oldSuffix newSuffix str
- | not (oldSuffix `isSuffixOf` str) = error $
- "compileHsObject.change: " ++ oldSuffix ++
- " not a suffix of " ++ str
- | otherwise = take (length str - length oldSuffix) str
- ++ newSuffix
+ HsObject _basename (Extension way Hi ) -> need [objpath -<.> osuf way]
+ HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way]
+ HsObject _basename (Extension way suf) -> do
+ let ctx = objectContext b
+ ctxPath <- contextPath ctx
+ (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
+ need (src:deps)
+ needLibrary =<< contextDependencies ctx
+ buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
+ -- Andrey: It appears that the previous refactoring has broken
+ -- multiple-output build rules. Ideally, we should bring multiple-output
+ -- rules back, see: https://github.com/snowleopard/hadrian/issues/216.
+ -- As a temporary solution, I'm using Shake's new 'produces' feature to
+ -- record that this rule also produces a corresponding interface file.
+ let hi | suf == O = objpath -<.> hisuf way
+ | suf == OBoot = objpath -<.> hibootsuf way
+ | otherwise = error "Internal error: unknown Haskell object extension"
+ produces [hi]
compileNonHsObject
:: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject
@@ -214,11 +191,11 @@ compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj =
toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile
go builder tosrc = do
- ctx <- objectContext b
- src <- tosrc ctx objpath
- need [src]
- needDependencies ctx src (objpath <.> "d")
- buildWithResources rs $ target ctx (builder stage) [src] [objpath]
+ let ctx = objectContext b
+ src <- tosrc ctx objpath
+ need [src]
+ needDependencies ctx src (objpath <.> "d")
+ buildWithResources rs $ target ctx (builder stage) [src] [objpath]
compileObject
:: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action ()
diff --git a/hadrian/src/Rules/Configure.hs b/hadrian/src/Rules/Configure.hs
index 909b3c3357..8395472a4b 100644
--- a/hadrian/src/Rules/Configure.hs
+++ b/hadrian/src/Rules/Configure.hs
@@ -42,6 +42,8 @@ configureRules = do
when System.isWindows $ do
root <- buildRoot
copyDirectory "inplace/mingw" (root -/- "mingw")
+ mingwFiles <- liftIO $ getDirectoryFilesIO "." [root -/- "mingw/**"]
+ produces mingwFiles
["configure", configH <.> "in"] &%> \_ -> do
skip <- not <$> cmdConfigure
diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
index 8b09a82b56..9a2a23354f 100644
--- a/hadrian/src/Rules/Dependencies.hs
+++ b/hadrian/src/Rules/Dependencies.hs
@@ -9,7 +9,7 @@ import Expression
import Hadrian.BuildPath
import Oracles.ModuleFiles
import Rules.Generate
-import Settings.Default
+import Settings
import Target
import Utilities
@@ -19,17 +19,15 @@ buildPackageDependencies :: [(Resource, Int)] -> Rules ()
buildPackageDependencies rs = do
root <- buildRootRules
root -/- "**/.dependencies.mk" %> \mk -> do
- depfile <- getDepMkFile root mk
- context <- depMkFileContext depfile
+ DepMkFile stage pkgpath <- getDepMkFile root mk
+ let context = Context stage (unsafeFindPackageByPath pkgpath) vanilla
srcs <- hsSources context
- need srcs
- orderOnly =<< interpretInContext context generatedDependencies
+ gens <- interpretInContext context generatedDependencies
+ need (srcs ++ gens)
if null srcs
then writeFileChanged mk ""
- else buildWithResources rs $
- target context
- (Ghc FindHsDependencies $ Context.stage context)
- srcs [mk]
+ else buildWithResources rs $ target context
+ (Ghc FindHsDependencies $ Context.stage context) srcs [mk]
removeFile $ mk <.> "bak"
root -/- "**/.dependencies" %> \deps -> do
@@ -43,22 +41,16 @@ buildPackageDependencies rs = do
$ parseMakefile mkDeps
-data DepMkFile = DepMkFile Stage FilePath
- deriving (Eq, Show)
+data DepMkFile = DepMkFile Stage FilePath deriving (Eq, Show)
parseDepMkFile :: FilePath -> Parsec.Parsec String () DepMkFile
parseDepMkFile root = do
- _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
- stage <- parseStage
- _ <- Parsec.char '/'
- pkgPath <- Parsec.manyTill Parsec.anyChar
- (Parsec.try $ Parsec.string "/.dependencies.mk")
- return (DepMkFile stage pkgPath)
+ _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
+ stage <- parseStage
+ _ <- Parsec.char '/'
+ pkgPath <- Parsec.manyTill Parsec.anyChar
+ (Parsec.try $ Parsec.string "/.dependencies.mk")
+ return (DepMkFile stage pkgPath)
getDepMkFile :: FilePath -> FilePath -> Action DepMkFile
getDepMkFile root = parsePath (parseDepMkFile root) "<dependencies file>"
-
-depMkFileContext :: DepMkFile -> Action Context
-depMkFileContext (DepMkFile stage pkgpath) = do
- pkg <- getPackageByPath pkgpath
- return (Context stage pkg vanilla)
diff --git a/hadrian/src/Rules/Documentation.hs b/hadrian/src/Rules/Documentation.hs
index 2d7a4b1ef7..c9de3038ed 100644
--- a/hadrian/src/Rules/Documentation.hs
+++ b/hadrian/src/Rules/Documentation.hs
@@ -141,7 +141,7 @@ buildPackageDocumentation = do
-- Per-package haddocks
root -/- htmlRoot -/- "libraries/*/haddock-prologue.txt" %> \file -> do
- ctx <- getPkgDocTarget root file >>= pkgDocContext
+ ctx <- pkgDocContext <$> getPkgDocTarget root file
-- This is how @ghc-cabal@ used to produces "haddock-prologue.txt" files.
syn <- pkgSynopsis (Context.package ctx)
desc <- pkgDescription (Context.package ctx)
@@ -149,7 +149,7 @@ buildPackageDocumentation = do
liftIO $ writeFile file prologue
root -/- htmlRoot -/- "libraries/*/*.haddock" %> \file -> do
- context <- getPkgDocTarget root file >>= pkgDocContext
+ context <- pkgDocContext <$> getPkgDocTarget root file
need [ takeDirectory file -/- "haddock-prologue.txt"]
haddocks <- haddockDependencies context
@@ -172,14 +172,11 @@ buildPackageDocumentation = do
data PkgDocTarget = DotHaddock PackageName | HaddockPrologue PackageName
deriving (Eq, Show)
-pkgDocContext :: PkgDocTarget -> Action Context
-pkgDocContext target = case findPackageByName pkgname of
- Nothing -> error $ "pkgDocContext: couldn't find package " ++ pkgname
- Just p -> return (Context Stage1 p vanilla)
-
- where pkgname = case target of
- DotHaddock n -> n
- HaddockPrologue n -> n
+pkgDocContext :: PkgDocTarget -> Context
+pkgDocContext target = Context Stage1 (unsafeFindPackageByName name) vanilla
+ where
+ name = case target of DotHaddock n -> n
+ HaddockPrologue n -> n
parsePkgDocTarget :: FilePath -> Parsec.Parsec String () PkgDocTarget
parsePkgDocTarget root = do
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 9db5b198e4..13544f2a7d 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -1,6 +1,7 @@
module Rules.Generate (
- isGeneratedCmmFile, generatePackageCode, generateRules, copyRules,
- includesDependencies, generatedDependencies, ghcPrimDependencies
+ isGeneratedCmmFile, compilerDependencies, generatePackageCode,
+ generateRules, copyRules, generatedDependencies, generatedGhcDependencies,
+ ghcPrimDependencies
) where
import Base
@@ -26,18 +27,9 @@ primopsSource = "compiler/prelude/primops.txt.pp"
primopsTxt :: Stage -> FilePath
primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt"
-platformH :: Stage -> FilePath
-platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
-
isGeneratedCmmFile :: FilePath -> Bool
isGeneratedCmmFile file = takeBaseName file == "AutoApply"
-includesDependencies :: [FilePath]
-includesDependencies = fmap (generatedDir -/-)
- [ "ghcautoconf.h"
- , "ghcplatform.h"
- , "ghcversion.h" ]
-
ghcPrimDependencies :: Expr [FilePath]
ghcPrimDependencies = do
stage <- getStage
@@ -59,9 +51,7 @@ compilerDependencies = do
ghcPath <- expr $ buildPath (vanillaContext stage compiler)
gmpPath <- expr gmpBuildPath
rtsPath <- expr (rtsBuildPath stage)
- mconcat [ return [root -/- platformH stage]
- , return ((root -/-) <$> includesDependencies)
- , return ((root -/-) <$> derivedConstantsDependencies)
+ mconcat [ return ((root -/-) <$> derivedConstantsDependencies)
, notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
, notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)
, return $ fmap (ghcPath -/-)
@@ -83,15 +73,16 @@ compilerDependencies = do
generatedDependencies :: Expr [FilePath]
generatedDependencies = do
- root <- getBuildRoot
- stage <- getStage
- rtsPath <- expr (rtsBuildPath stage)
+ root <- getBuildRoot
+ stage <- getStage
+ rtsPath <- expr (rtsBuildPath stage)
+ includes <- expr includesDependencies
mconcat [ package compiler ? compilerDependencies
, package ghcPrim ? ghcPrimDependencies
, package rts ? return (fmap (rtsPath -/-) libffiDependencies
- ++ fmap (root -/-) includesDependencies
+ ++ includes
++ fmap (root -/-) derivedConstantsDependencies)
- , stage0 ? return (fmap (root -/-) includesDependencies) ]
+ , stage0 ? return includes ]
generate :: FilePath -> Context -> Expr String -> Action ()
generate file context expr = do
@@ -111,40 +102,38 @@ generatePackageCode context@(Context stage pkg _) = do
need [src]
build $ target context builder [src] [file]
let boot = src -<.> "hs-boot"
- whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
+ whenM (doesFileExist boot) $ do
+ let target = file -<.> "hs-boot"
+ copyFile boot target
+ produces [target]
priority 2.0 $ do
- when (pkg == compiler) $ do root <//> dir -/- "Config.hs" %> go generateConfigHs
- root <//> dir -/- "*.hs-incl" %> genPrimopCode context
- when (pkg == ghcPrim) $ do (root <//> dir -/- "GHC/Prim.hs") %> genPrimopCode context
- (root <//> dir -/- "GHC/PrimopWrappers.hs") %> genPrimopCode context
- when (pkg == ghcPkg) $ do root <//> dir -/- "Version.hs" %> go generateVersionHs
+ when (pkg == compiler) $ do
+ root <//> dir -/- "Config.hs" %> go generateConfigHs
+ root <//> dir -/- "*.hs-incl" %> genPrimopCode context
+ when (pkg == ghcPrim) $ do
+ root <//> dir -/- "GHC/Prim.hs" %> genPrimopCode context
+ root <//> dir -/- "GHC/PrimopWrappers.hs" %> genPrimopCode context
+ when (pkg == ghcPkg) $
+ root <//> dir -/- "Version.hs" %> go generateVersionHs
- -- TODO: needing platformH is ugly and fragile
when (pkg == compiler) $ do
root -/- primopsTxt stage %> \file -> do
- root <- buildRoot
- need $ [ root -/- platformH stage
- , primopsSource]
- ++ fmap (root -/-) includesDependencies
+ includes <- includesDependencies
+ need $ [primopsSource] ++ includes
build $ target context HsCpp [primopsSource] [file]
- -- only generate this once! Until we have the include logic fixed.
- -- See the note on `platformH`
- when (stage == Stage0) $ do
- root <//> "compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH
- root <//> platformH stage %> go generateGhcBootPlatformH
+ root -/- stageString stage <//> "ghc_boot_platform.h" %>
+ go generateGhcBootPlatformH
when (pkg == rts) $ do
root <//> dir -/- "cmm/AutoApply.cmm" %> \file ->
build $ target context GenApply [] [file]
- -- XXX: this should be fixed properly, e.g. generated here on demand.
+ -- TODO: This should be fixed properly, e.g. generated here on demand.
(root <//> dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir))
(root <//> dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir))
(root <//> dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir))
(root <//> dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir))
- when (pkg == integerGmp) $ do
- (root <//> dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include"))
where
pattern <~ mdir = pattern %> \file -> do
dir <- mdir
diff --git a/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
index 8e0d338c51..a78170cf6a 100644
--- a/hadrian/src/Rules/Gmp.hs
+++ b/hadrian/src/Rules/Gmp.hs
@@ -1,6 +1,4 @@
-module Rules.Gmp (
- gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH
- ) where
+module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH) where
import Base
import Context
@@ -41,6 +39,10 @@ gmpContext = vanillaContext Stage1 integerGmp
gmpBuildPath :: Action FilePath
gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
+-- | Like 'gmpBuildPath' but in the 'Rules' monad.
+gmpBuildPathRules :: Rules FilePath
+gmpBuildPathRules = buildRootRules <&> (-/- stageString (stage gmpContext) -/- "gmp")
+
-- | GMP library header, relative to 'gmpBuildPath'.
gmpLibraryH :: FilePath
gmpLibraryH = "include/ghc-gmp.h"
@@ -57,8 +59,8 @@ configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
gmpRules :: Rules ()
gmpRules = do
-- Copy appropriate GMP header and object files
- root <- buildRootRules
- root <//> gmpLibraryH %> \header -> do
+ gmpPath <- gmpBuildPathRules
+ gmpPath -/- gmpLibraryH %> \header -> do
windows <- windowsHost
configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
if not windows && -- TODO: We don't use system GMP on Windows. Fix?
@@ -68,46 +70,39 @@ gmpRules = do
copyFile (gmpBase -/- "ghc-gmp.h") header
else do
putBuild "| No GMP library/framework detected; in tree GMP will be built"
- gmpPath <- gmpBuildPath
need [gmpPath -/- gmpLibrary]
createDirectory (gmpPath -/- gmpObjectsDir)
top <- topDirectory
build $ target gmpContext (Ar Unpack Stage1)
[top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
- copyFile (gmpPath -/- "gmp.h") header
- copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
+ objs <- liftIO $ getDirectoryFilesIO "." [gmpPath -/- gmpObjectsDir -/- "*"]
+ produces objs
+ copyFileUntracked (gmpPath -/- "gmp.h") header
-- Build in-tree GMP library, prioritised so that it matches "before"
- -- the generic .a library rule in Rules.Library, whenever applicable.
- priority 2.0 $ root <//> gmpLibrary %> \lib -> do
- gmpPath <- gmpBuildPath
+ -- the generic @.a@ library rule in 'Rules.Library'.
+ priority 2.0 $ gmpPath -/- gmpLibrary %> \lib -> do
build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
putSuccess "| Successfully built custom library 'gmp'"
- -- In-tree GMP header is built by the gmpLibraryH rule
- root <//> gmpLibraryInTreeH %> \_ -> do
- gmpPath <- gmpBuildPath
- need [gmpPath -/- gmpLibraryH]
+ gmpPath -/- gmpLibraryInTreeH %> copyFile (gmpPath -/- gmpLibraryH)
+
+ root <- buildRootRules
+ root -/- buildDir gmpContext -/- gmpLibraryH %>
+ copyFile (gmpPath -/- gmpLibraryH)
- -- This causes integerGmp package to be configured, hence creating the files
- root <//> "gmp/config.mk" %> \_ -> do
- -- Calling 'need' on @setup-config@ triggers 'configurePackage'.
- -- TODO: Shall we run 'configurePackage' directly? Why this indirection?
- setupConfig <- pkgSetupConfigFile gmpContext
- need [setupConfig]
+ -- This file is created when 'integerGmp' is configured.
+ gmpPath -/- "config.mk" %> \_ -> ensureConfigured gmpContext
- -- TODO: Get rid of hard-coded @gmp@.
-- Run GMP's configure script
- root <//> "gmp/Makefile" %> \mk -> do
- env <- configureEnvironment
- gmpPath <- gmpBuildPath
+ gmpPath -/- "Makefile" %> \mk -> do
+ env <- configureEnvironment
need [mk <.> "in"]
buildWithCmdOptions env $
target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
-- Extract in-tree GMP sources and apply patches
- root <//> "gmp/Makefile.in" %> \_ -> do
- gmpPath <- gmpBuildPath
+ fmap (gmpPath -/-) ["Makefile.in", "configure"] &%> \_ -> do
removeDirectory gmpPath
-- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
-- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
index 465065e7ce..1fe6174b1e 100644
--- a/hadrian/src/Rules/Libffi.hs
+++ b/hadrian/src/Rules/Libffi.hs
@@ -43,17 +43,16 @@ configureEnvironment stage = do
, return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
libffiRules :: Rules ()
-libffiRules =
- forM_ [Stage1 ..] $ \stage -> do
- root <- buildRootRules
- fmap ((root -/- stageString stage -/- "rts/build") -/-) libffiDependencies
- &%> \_ -> do
- libffiPath <- libffiBuildPath stage
- need [libffiPath -/- libffiLibrary]
-
- -- we set a higher priority because this overlaps
- -- with the static lib rule from Rules.Library.libraryRules.
- priority 2.0 $ root -/- stageString stage <//> libffiLibrary %> \_ -> do
+libffiRules = forM_ [Stage1 ..] $ \stage -> do
+ root <- buildRootRules
+ let path = root -/- stageString stage
+ libffiPath = path -/- pkgName libffi -/- "build"
+ libffiOuts = [libffiPath -/- libffiLibrary] ++
+ fmap ((path -/- "rts/build") -/-) libffiDependencies
+
+ -- We set a higher priority because this rule overlaps with the build rule
+ -- for static libraries 'Rules.Library.libraryRules'.
+ priority 2.0 $ libffiOuts &%> \(out : _) -> do
useSystemFfi <- flag UseSystemFfi
rtsPath <- rtsBuildPath stage
if useSystemFfi
@@ -64,23 +63,25 @@ libffiRules =
copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
putSuccess "| Successfully copied system FFI library header files"
else do
- libffiPath <- libffiBuildPath stage
build $ target (libffiContext stage) (Make libffiPath) [] []
- hs <- getDirectoryFiles "" [libffiPath -/- "inst/include/*"]
- forM_ hs $ \header ->
- copyFile header (rtsPath -/- takeFileName header)
+ -- Here we produce 'libffiDependencies'
+ hs <- liftIO $ getDirectoryFilesIO "" [libffiPath -/- "inst/include/*"]
+ forM_ hs $ \header -> do
+ let target = rtsPath -/- takeFileName header
+ copyFileUntracked header target
+ produces [target]
ways <- interpretInContext (libffiContext stage)
(getLibraryWays <> getRtsWays)
forM_ (nubOrd ways) $ \way -> do
rtsLib <- rtsLibffiLibrary stage way
- copyFileUntracked (libffiPath -/- libffiLibrary) rtsLib
+ copyFileUntracked out rtsLib
+ produces [rtsLib]
putSuccess "| Successfully built custom library 'libffi'"
- root -/- stageString stage -/- "libffi/build/Makefile.in" %> \mkIn -> do
- libffiPath <- libffiBuildPath stage
+ fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do
removeDirectory libffiPath
tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
<$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
@@ -93,21 +94,25 @@ libffiRules =
removeDirectory (root -/- libname)
-- TODO: Simplify.
actionFinally (do
- build $ target (libffiContext stage) (Tar Extract)
- [tarball]
- [root -/- stageString stage]
- moveDirectory (root -/- stageString stage -/- libname) libffiPath) $
- removeFiles (root -/- stageString stage) [libname <//> "*"]
+ build $ target (libffiContext stage) (Tar Extract) [tarball] [path]
+ moveDirectory (path -/- libname) libffiPath) $
+ -- And finally:
+ removeFiles (path) [libname <//> "*"]
top <- topDirectory
fixFile mkIn (fixLibffiMakefile top)
- -- TODO: Get rid of hard-coded @libffi@.
- root -/- stageString stage -/- "libffi/build/Makefile" %> \mk -> do
+ files <- liftIO $ getDirectoryFilesIO "." [libffiPath <//> "*"]
+ produces files
+
+ fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do
need [mk <.> "in"]
- libffiPath <- libffiBuildPath stage
forM_ ["config.guess", "config.sub"] $ \file -> do
copyFile file (libffiPath -/- file)
env <- configureEnvironment stage
buildWithCmdOptions env $
- target (libffiContext stage) (Configure libffiPath) [mk <.> "in"] [mk]
+ target (libffiContext stage) (Configure libffiPath) [mk <.> "in"] [mk]
+
+ dir <- setting BuildPlatform
+ files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir <//> "*"]
+ produces files
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index ef56da5eae..d215938385 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -4,9 +4,11 @@ import Base
import Context
import Hadrian.BuildPath
import Hadrian.Expression
+import Hadrian.Haskell.Cabal
+import Oracles.Setting
import Packages
+import Rules.Gmp
import Settings
-import Settings.Default
import Target
import Utilities
@@ -21,27 +23,41 @@ import qualified Text.Parsec as Parsec
-- * Configuring
--- | Configure a package and build its @setup-config@ file.
+-- | Configure a package and build its @setup-config@ file, as well as files in
+-- the @build/pkgName/build/autogen@ directory.
configurePackageRules :: Rules ()
configurePackageRules = do
root <- buildRootRules
- root -/- "**/setup-config" %> \path ->
- parsePath (parseSetupConfig root) "<setup config path parser>" path
- >>= configurePackage
+ root -/- "**/setup-config" %> \out -> do
+ (stage, path) <- parsePath (parseSetupConfig root) "<setup config path parser>" out
+ let pkg = unsafeFindPackageByPath path
+ Cabal.configurePackage (Context stage pkg vanilla)
+
+ root -/- "**/autogen/cabal_macros.h" %> \out -> do
+ (stage, path) <- parsePath (parseToBuildSubdirectory root) "<cabal macros path parser>" out
+ let pkg = unsafeFindPackageByPath path
+ Cabal.buildAutogenFiles (Context stage pkg vanilla)
+
+ root -/- "**/autogen/Paths_*.hs" %> \out ->
+ need [takeDirectory out -/- "cabal_macros.h"]
parseSetupConfig :: FilePath -> Parsec.Parsec String () (Stage, FilePath)
parseSetupConfig root = do
- _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
- stage <- parseStage
- _ <- Parsec.char '/'
- pkgPath <- Parsec.manyTill Parsec.anyChar
- (Parsec.try $ Parsec.string "/setup-config")
- return (stage, pkgPath)
-
-configurePackage :: (Stage, FilePath) -> Action ()
-configurePackage (stage, pkgpath) = do
- pkg <- getPackageByPath pkgpath
- Cabal.configurePackage (Context stage pkg vanilla)
+ _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
+ stage <- parseStage
+ _ <- Parsec.char '/'
+ pkgPath <- Parsec.manyTill Parsec.anyChar
+ (Parsec.try $ Parsec.string "/setup-config")
+ return (stage, pkgPath)
+
+parseToBuildSubdirectory :: FilePath -> Parsec.Parsec String () (Stage, FilePath)
+parseToBuildSubdirectory root = do
+ _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
+ stage <- parseStage
+ _ <- Parsec.char '/'
+ pkgPath <- Parsec.manyTill Parsec.anyChar
+ (Parsec.try $ Parsec.string "/build/")
+ return (stage, pkgPath)
-- * Registering
@@ -57,6 +73,7 @@ registerPackageRules rs stage = do
-- Register a package.
root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
+ historyDisable
let libpath = takeDirectory (takeDirectory conf)
settings = libpath -/- "settings"
platformConstants = libpath -/- "platformConstants"
@@ -64,7 +81,7 @@ registerPackageRules rs stage = do
need [settings, platformConstants]
pkgName <- getPackageNameFromConfFile conf
- pkg <- getPackageByName pkgName
+ let pkg = unsafeFindPackageByName pkgName
isBoot <- (pkg `notElem`) <$> stagePackages Stage0
let ctx = Context stage pkg vanilla
@@ -73,12 +90,9 @@ registerPackageRules rs stage = do
_ -> buildConf rs ctx conf
buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildConf _ context@Context {..} _conf = do
+buildConf _ context@Context {..} conf = do
depPkgIds <- cabalDependencies context
-
- -- Calling 'need' on @setupConfig@, triggers the package configuration.
- setupConfig <- pkgSetupConfigFile context
- need [setupConfig]
+ ensureConfigured context
need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)
@@ -97,12 +111,28 @@ buildConf _ context@Context {..} _conf = do
, path -/- "ghcversion.h"
, path -/- "ffi.h" ]
- when (package == integerGmp) $ need [path -/- "ghc-gmp.h"]
+ when (package == integerGmp) $ need [path -/- gmpLibraryH]
-- Copy and register the package.
Cabal.copyPackage context
Cabal.registerPackage context
+ -- The above two steps produce an entry in the package database, with copies
+ -- of many of the files we have build, e.g. Haskell interface files. We need
+ -- to record this side effect so that Shake can cache these files too.
+ -- See why we need 'fixWindows': https://ghc.haskell.org/trac/ghc/ticket/16073
+ let fixWindows path = do
+ win <- windowsHost
+ version <- setting GhcVersion
+ hostOs <- cabalOsString <$> setting BuildOs
+ hostArch <- cabalArchString <$> setting BuildArch
+ let dir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
+ return $ if win then path -/- "../.." -/- dir else path
+ pkgDbPath <- fixWindows =<< packageDbPath stage
+ let dir = pkgDbPath -/- takeBaseName conf
+ files <- liftIO $ getDirectoryFilesIO "." [dir -/- "**"]
+ produces files
+
copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
copyConf rs context@Context {..} conf = do
depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $
@@ -126,18 +156,14 @@ copyConf rs context@Context {..} conf = do
getPackageNameFromConfFile :: FilePath -> Action String
getPackageNameFromConfFile conf
- | takeBaseName conf == "rts" = return "rts"
- | otherwise = case parseCabalName (takeBaseName conf) of
- Left err -> error $ "getPackageNameFromConfFile: couldn't parse " ++ takeBaseName conf ++ ": " ++ err
- Right (name, _) -> return name
+ | takeBaseName conf == "rts" = return "rts"
+ | otherwise = case parseCabalName (takeBaseName conf) of
+ Left err -> error $ "getPackageNameFromConfFile: Couldn't parse " ++
+ takeBaseName conf ++ ": " ++ err
+ Right (name, _) -> return name
parseCabalName :: String -> Either String (String, Version)
parseCabalName = fmap f . Cabal.eitherParsec
where
f :: Cabal.PackageId -> (String, Version)
f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id)
-
-getPackageByName :: String -> Action Package
-getPackageByName n = case findPackageByName n of
- Nothing -> error $ "getPackageByName: couldn't find " ++ n
- Just p -> return p
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
index 519d1fc80c..fdbef1c359 100755
--- a/hadrian/src/Settings.hs
+++ b/hadrian/src/Settings.hs
@@ -1,7 +1,7 @@
module Settings (
getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
- findPackageByName, isLibrary, stagePackages, programContext,
- getIntegerPackage
+ findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath,
+ isLibrary, stagePackages, programContext, getIntegerPackage
) where
import CommandLine
@@ -66,3 +66,13 @@ knownPackages = sort $ ghcPackages ++ userPackages
-- Note: this is slow but we keep it simple as there are just ~50 packages
findPackageByName :: PackageName -> Maybe Package
findPackageByName name = find (\pkg -> pkgName pkg == name) knownPackages
+
+unsafeFindPackageByName :: PackageName -> Package
+unsafeFindPackageByName name = fromMaybe (error msg) $ findPackageByName name
+ where
+ msg = "unsafeFindPackageByName: No package with name " ++ name
+
+unsafeFindPackageByPath :: FilePath -> Package
+unsafeFindPackageByPath path = err $ find (\pkg -> pkgPath pkg == path) knownPackages
+ where
+ err = fromMaybe $ error ("findPackageByPath: No package for path " ++ path)
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 488e551cdc..f18832c1ef 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -146,6 +146,8 @@ includeGhcArgs = do
context <- getContext
srcDirs <- getContextData srcDirs
autogen <- expr $ autogenPath context
+ let cabalMacros = autogen -/- "cabal_macros.h"
+ expr $ need [cabalMacros]
mconcat [ arg "-i"
, arg $ "-i" ++ path
, arg $ "-i" ++ autogen
@@ -153,7 +155,7 @@ includeGhcArgs = do
, cIncludeArgs
, arg $ "-I" ++ root -/- generatedDir
, arg $ "-optc-I" ++ root -/- generatedDir
- , pure ["-optP-include", "-optP" ++ autogen -/- "cabal_macros.h"] ]
+ , pure ["-optP-include", "-optP" ++ cabalMacros] ]
-- Check if building dynamically is required. GHC is a special case that needs
-- to be built dynamically if any of the RTS ways is dynamic.
diff --git a/hadrian/src/Settings/Builders/GhcPkg.hs b/hadrian/src/Settings/Builders/GhcPkg.hs
index bc8303f5a1..9223a9d85a 100644
--- a/hadrian/src/Settings/Builders/GhcPkg.hs
+++ b/hadrian/src/Settings/Builders/GhcPkg.hs
@@ -4,8 +4,7 @@ import Settings.Builders.Common
ghcPkgBuilderArgs :: Args
ghcPkgBuilderArgs = mconcat
- [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ]
- , builder (GhcPkg Copy) ? do
+ [ builder (GhcPkg Copy) ? do
verbosity <- expr getVerbosity
stage <- getStage
pkgDb <- expr $ packageDbPath stage
diff --git a/hadrian/src/Settings/Builders/Hsc2Hs.hs b/hadrian/src/Settings/Builders/Hsc2Hs.hs
index 0d5363d413..e2b9e44260 100644
--- a/hadrian/src/Settings/Builders/Hsc2Hs.hs
+++ b/hadrian/src/Settings/Builders/Hsc2Hs.hs
@@ -40,6 +40,8 @@ getCFlags :: Expr [String]
getCFlags = do
context <- getContext
autogen <- expr $ autogenPath context
+ let cabalMacros = autogen -/- "cabal_macros.h"
+ expr $ need [cabalMacros]
mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
, getStagedSettingList ConfCppArgs
, cIncludeArgs
@@ -48,7 +50,7 @@ getCFlags = do
, getContextData cppOpts
, getContextData depCcOpts
, cWarnings
- , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
+ , arg "-include", arg cabalMacros ]
getLFlags :: Expr [String]
getLFlags =
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index cec1d6616a..de5261372a 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -1,6 +1,6 @@
module Settings.Default (
-- * Packages that are build by default and for the testsuite
- defaultPackages, testsuitePackages, getPackageByPath,
+ defaultPackages, testsuitePackages,
-- * Default build ways
defaultLibraryWays, defaultRtsWays,
@@ -139,13 +139,6 @@ testsuitePackages = do
, unlit ] ++
[ timeout | win ]
-getPackageByPath :: FilePath -> Action Package
-getPackageByPath pkgpath = do
- case filter (\p -> pkgPath p == pkgpath) knownPackages of
- (p:_) -> return p
- _ -> error $
- "getPackageByPath: couldn't find a package with path: " ++ pkgpath
-
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
-- * We build 'profiling' way when stage > Stage0.
diff --git a/utils/touchy/touchy.cabal b/utils/touchy/touchy.cabal
index 377051e28b..b9195fc496 100644
--- a/utils/touchy/touchy.cabal
+++ b/utils/touchy/touchy.cabal
@@ -10,7 +10,7 @@ Description: XXX
Category: Development
build-type: Simple
-Executable unlit
+Executable touchy
Default-Language: Haskell2010
Main-Is: touchy.c
C-Sources: touchy.c