Commit ef47d7b3 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Fix performance bug: do not call ghc-cabal to determine package targets

See #393
parent 8f244c41
......@@ -13,9 +13,9 @@ module Context (
import GHC.Generics
import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Base
import Oracles.PackageData
import Oracles.Setting
-- | Build context for a currently built 'Target'. We generate potentially
......@@ -68,10 +68,10 @@ contextDir :: Context -> FilePath
contextDir Context {..} = stageString stage -/- pkgPath package
pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context prefix suffix = do
path <- buildPath context
componentId <- pkgData $ ComponentId path
return $ path -/- prefix ++ componentId ++ suffix
pkgFile context@Context {..} prefix suffix = do
path <- buildPath context
pkgId <- pkgIdentifier package
return $ path -/- prefix ++ pkgId ++ suffix
-- | Path to inplace package configuration file of a given 'Context'.
pkgInplaceConfig :: Context -> Action FilePath
......@@ -120,13 +120,12 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o"
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile context@Context {..} = do
root <- buildRoot
path <- buildPath context
componentId <- pkgData $ ComponentId path
pkgConfFile Context {..} = do
root <- buildRoot
pkgId <- pkgIdentifier package
let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
| otherwise = inplacePackageDbPath
return $ dbDir -/- componentId <.> "conf"
return $ dbDir -/- pkgId <.> "conf"
-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its object file. For example:
......
......@@ -9,7 +9,9 @@
-- Basic functionality for extracting Haskell package metadata stored in
-- @.cabal@ files.
-----------------------------------------------------------------------------
module Hadrian.Haskell.Cabal (pkgNameVersion, pkgDependencies) where
module Hadrian.Haskell.Cabal (
pkgNameVersion, pkgIdentifier, pkgDependencies
) where
import Development.Shake
......@@ -24,6 +26,20 @@ pkgNameVersion pkg = do
cabal <- readCabalFile (pkgCabalFile pkg)
return (name cabal, version cabal)
-- | Read the @.cabal@ file of a given package and return the package identifier.
-- If the @.cabal@ file does not exist return the package name. If the @.cabal@
-- file exists it is tracked.
pkgIdentifier :: Package -> Action String
pkgIdentifier pkg = do
cabalExists <- doesFileExist (pkgCabalFile pkg)
if cabalExists
then do
cabal <- readCabalFile (pkgCabalFile pkg)
return $ if (null $ version cabal)
then name cabal
else name cabal ++ "-" ++ version cabal
else return (pkgName pkg)
-- | Read the @.cabal@ file of a given package and return the sorted list of its
-- dependencies. The current version does not take care of Cabal conditionals
-- and therefore returns a crude overapproximation of actual dependencies. The
......
......@@ -22,11 +22,12 @@ import qualified Distribution.Verbosity as C
import Hadrian.Haskell.Package
-- TODO: Use fine-grain tracking instead of tracking the whole @.cabal@ file.
-- | Haskell package metadata extracted from a @.cabal@ file.
data Cabal = Cabal
{ name :: PackageName
{ dependencies :: [PackageName]
, name :: PackageName
, version :: String
, dependencies :: [PackageName]
} deriving (Eq, Read, Show, Typeable)
instance Binary Cabal where
......@@ -51,7 +52,7 @@ parseCabal file = do
allDeps = concat (libDeps : exeDeps)
sorted = sort [ C.unPackageName p | C.Dependency p _ <- allDeps ]
deps = nubOrd sorted \\ [name]
return $ Cabal name version deps
return $ Cabal deps name version
collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]
collectDeps Nothing = []
......
......@@ -7,7 +7,6 @@ import Hadrian.Oracles.TextFile
import Base
data PackageData = BuildGhciLib FilePath
| ComponentId FilePath
| Synopsis FilePath
| Version FilePath
......@@ -40,7 +39,6 @@ askPackageData path = lookupValueOrEmpty (path -/- "package-data.mk")
pkgData :: PackageData -> Action String
pkgData packageData = case packageData of
BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
ComponentId path -> askPackageData path "COMPONENT_ID"
Synopsis path -> askPackageData path "SYNOPSIS"
Version path -> askPackageData path "VERSION"
......
......@@ -37,17 +37,26 @@ topLevelTargets = action $ do
need =<< if stage1Only
then do
libs <- concatForM [Stage0, Stage1] $ \stage ->
concatForM libraryPackages $ packageTargets stage
prgs <- concatForM programsStage1Only $ packageTargets Stage0
concatForM libraryPackages $ packageTargets False stage
prgs <- concatForM programsStage1Only $ packageTargets False Stage0
return $ libs ++ prgs ++ inplaceLibCopyTargets
else do
targets <- concatForM allStages $ \stage ->
concatForM (knownPackages \\ [rts, libffi]) $ packageTargets stage
concatForM (knownPackages \\ [rts, libffi]) $
packageTargets False stage
return $ targets ++ inplaceLibCopyTargets
-- TODO: Get rid of the @includeGhciLib@ hack.
-- | Return the list of targets associated with a given 'Stage' and 'Package'.
packageTargets :: Stage -> Package -> Action [FilePath]
packageTargets stage pkg = do
-- By setting the Boolean parameter to False it is possible to exclude the GHCi
-- library from the targets, and avoid running @ghc-cabal@ to determine wether
-- GHCi library needs to be built for this package. We typically want to set
-- this parameter to True, however it is important to set it to False when
-- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
-- because we need to run @ghc-cabal@ in the order respecting package dependencies.
packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
packageTargets includeGhciLib stage pkg = do
let context = vanillaContext stage pkg
activePackages <- interpretInContext context getPackages
if pkg `notElem` activePackages
......@@ -57,7 +66,7 @@ packageTargets stage pkg = do
ways <- interpretInContext context getLibraryWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways
docs <- interpretInContext context =<< buildHaddock <$> flavour
more <- libraryTargets context
more <- libraryTargets includeGhciLib context
setup <- pkgSetupConfigFile context
haddock <- pkgHaddockFile context
return $ [ setup | nonCabalContext context ]
......
......@@ -189,7 +189,7 @@ installPackages = do
installDistDir <- buildPath context
let absInstallDistDir = top -/- installDistDir
need =<< packageTargets stage pkg
need =<< packageTargets True stage pkg
docDir <- installDocDir
ghclibDir <- installGhcLibDir
......
......@@ -2,6 +2,8 @@ module Settings.Builders.Ghc (
ghcBuilderArgs, ghcMBuilderArgs, haddockGhcArgs, ghcCbuilderArgs
) where
import Hadrian.Haskell.Cabal
import Flavour
import Rules.Gmp
import Settings.Builders.Common
......@@ -116,7 +118,8 @@ wayGhcArgs = do
-- FIXME: Get rid of to-be-deprecated -this-package-key.
packageGhcArgs :: Args
packageGhcArgs = do
compId <- getPkgData ComponentId
pkg <- getPackage
pkgId <- expr $ pkgIdentifier pkg
thisArg <- do
not0 <- notStage0
unit <- expr $ flag SupportsThisUnitId
......@@ -124,7 +127,7 @@ packageGhcArgs = do
mconcat [ arg "-hide-all-packages"
, arg "-no-user-package-db"
, bootPackageDatabaseArgs
, libraryPackage ? arg (thisArg ++ compId)
, libraryPackage ? arg (thisArg ++ pkgId)
, map ("-package-id " ++) <$> getPkgDataList DepIds ]
includeGhcArgs :: Args
......
......@@ -203,21 +203,24 @@ stage1Dependencies :: Package -> Action [Package]
stage1Dependencies =
fmap (map Context.package) . contextDependencies . vanillaContext Stage1
-- | Given a library 'Package' this action computes all of its targets.
libraryTargets :: Context -> Action [FilePath]
libraryTargets context = do
-- | Given a library 'Package' this action computes all of its targets. See
-- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
libraryTargets :: Bool -> Context -> Action [FilePath]
libraryTargets includeGhciLib context = do
confFile <- pkgConfFile context
libFile <- pkgLibraryFile context
lib0File <- pkgLibraryFile0 context
lib0 <- buildDll0 context
ghciLib <- pkgGhciLibraryFile context
ghciFlag <- interpretInContext context $ getPkgData BuildGhciLib
ghciFlag <- if includeGhciLib
then interpretInContext context $ getPkgData BuildGhciLib
else return "NO"
let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only)
return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
-- | Coarse-grain 'need': make sure all given libraries are fully built.
needLibrary :: [Context] -> Action ()
needLibrary cs = need =<< concatMapM libraryTargets cs
needLibrary cs = need =<< concatMapM (libraryTargets True) cs
-- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.
-- | Topological sort of packages according to their dependencies.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment