Major refactoring of path settings
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Wed, 16 Aug 2017 02:45:51 +0000 (03:45 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Wed, 16 Aug 2017 02:45:51 +0000 (03:45 +0100)
* Move buildRoot into the Action monad, so it can be configured from command line in future

* Move settings from Setting.Path to Base and Context

* Simplify build rule matching and prepare to factoring out common build rules into the library, #347

44 files changed:
hadrian.cabal
src/Base.hs
src/Context.hs
src/Expression.hs
src/GHC.hs
src/Hadrian/Expression.hs
src/Hadrian/Utilities.hs
src/Main.hs
src/Oracles/ModuleFiles.hs
src/Rules.hs
src/Rules/Cabal.hs
src/Rules/Clean.hs
src/Rules/Compile.hs
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Rules/Generate.hs
src/Rules/Gmp.hs
src/Rules/Install.hs
src/Rules/Libffi.hs
src/Rules/Library.hs
src/Rules/Program.hs
src/Rules/Register.hs
src/Rules/Selftest.hs
src/Rules/Test.hs
src/Rules/Wrappers.hs
src/Settings.hs
src/Settings/Builders/Common.hs
src/Settings/Builders/Configure.hs
src/Settings/Builders/DeriveConstants.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/GhcCabal.hs
src/Settings/Builders/GhcPkg.hs
src/Settings/Builders/Haddock.hs
src/Settings/Builders/HsCpp.hs
src/Settings/Builders/Hsc2Hs.hs
src/Settings/Builders/Make.hs
src/Settings/Install.hs [deleted file]
src/Settings/Packages/Ghc.hs
src/Settings/Packages/IntegerGmp.hs
src/Settings/Packages/Rts.hs
src/Settings/Path.hs [deleted file]
src/UserSettings.hs
src/Utilities.hs

index b9de806..8ad971f 100644 (file)
@@ -93,8 +93,6 @@ executable hadrian
                        , Settings.Packages.IntegerGmp
                        , Settings.Packages.Rts
                        , Settings.Packages.RunGhc
-                       , Settings.Path
-                       , Settings.Install
                        , Stage
                        , Target
                        , UserSettings
index 0994cf7..deccab6 100644 (file)
@@ -20,7 +20,10 @@ module Base (
     module Way,
 
     -- * Paths
-    configPath, configFile, sourcePath, configH
+    hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
+    bootPackageConstraints, packageDependencies, generatedDir, inplaceBinPath,
+    inplaceLibBinPath, inplaceLibPath, inplaceLibCopyTargets, templateHscPath,
+    stage0PackageDbDir, inplacePackageDbPath, packageDbStamp
     ) where
 
 import Control.Applicative
@@ -40,24 +43,85 @@ import Package
 import Stage
 import Way
 
--- | Hadrian lives in 'hadrianPath' directory of the GHC tree.
+-- | Hadrian lives in the 'hadrianPath' directory of the GHC tree.
 hadrianPath :: FilePath
 hadrianPath = "hadrian"
 
 -- TODO: Move this to build directory?
+-- | Path to system configuration files, such as 'configFile'.
 configPath :: FilePath
 configPath = hadrianPath -/- "cfg"
 
--- | Path to the file with configuration settings.
+-- | Path to the system configuration file generated by the @configure@ script.
 configFile :: FilePath
 configFile = configPath -/- "system.config"
 
 -- | Path to source files of the build system, e.g. this file is located at
--- sourcePath -/- "Base.hs". We use this to `need` some of the source files.
+-- @sourcePath -/- "Base.hs"@. We use this to track some of the source files.
 sourcePath :: FilePath
 sourcePath = hadrianPath -/- "src"
 
--- TODO: change @mk/config.h@ to @shake-build/cfg/config.h@
--- | Path to the generated @mk/config.h file.
+-- TODO: Change @mk/config.h@ to @shake-build/cfg/config.h@.
+-- | Path to the generated @mk/config.h@ file.
 configH :: FilePath
 configH = "mk/config.h"
+
+-- | The directory in 'buildRoot' containing the Shake database and other
+-- auxiliary files generated by Hadrian.
+shakeFilesDir :: FilePath
+shakeFilesDir = "hadrian"
+
+-- | The file storing boot package versions extracted from @.cabal@ files. It
+-- is generated by "Rules.Cabal".
+bootPackageConstraints :: FilePath
+bootPackageConstraints = shakeFilesDir -/- "boot-package-constraints"
+
+-- | The file storing package dependencies extracted from @.cabal@ files. It
+-- is generated by "Rules.Cabal".
+packageDependencies :: FilePath
+packageDependencies = shakeFilesDir -/- "package-dependencies"
+
+-- | The directory in 'buildRoot' containing generated source files that are not
+-- package-specific, e.g. @ghcplatform.h@.
+generatedDir :: FilePath
+generatedDir = "generated"
+
+-- | The directory in 'buildRoot' containing the 'Stage0' package database.
+stage0PackageDbDir :: FilePath
+stage0PackageDbDir = "stage0/bootstrapping.conf"
+
+-- | Path to the inplace package database used in 'Stage1' and later.
+inplacePackageDbPath :: FilePath
+inplacePackageDbPath = "inplace/lib/package.conf.d"
+
+-- | We use a stamp file to track the existence of a package database.
+packageDbStamp :: FilePath
+packageDbStamp = ".stamp"
+
+-- | Directory for binaries that are built "in place".
+inplaceBinPath :: FilePath
+inplaceBinPath = "inplace/bin"
+
+-- | Directory for libraries that are built "in place".
+inplaceLibPath :: FilePath
+inplaceLibPath = "inplace/lib"
+
+-- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
+inplaceLibBinPath :: FilePath
+inplaceLibBinPath = "inplace/lib/bin"
+
+-- ref: ghc/ghc.mk:142
+-- ref: driver/ghc.mk
+-- ref: utils/hsc2hs/ghc.mk:35
+-- | Files that need to be copied over to 'inplaceLibPath'.
+inplaceLibCopyTargets :: [FilePath]
+inplaceLibCopyTargets = map (inplaceLibPath -/-)
+    [ "ghc-usage.txt"
+    , "ghci-usage.txt"
+    , "platformConstants"
+    , "settings"
+    , "template-hsc.h" ]
+
+-- | Path to hsc2hs template.
+templateHscPath :: FilePath
+templateHscPath = "inplace/lib/template-hsc.h"
index 0e40bde..283816f 100644 (file)
@@ -1,12 +1,21 @@
 module Context (
-    Context (..), vanillaContext, stageContext, getStage, getPackage, getWay,
-    getStagedSettingList
+    -- * Context
+    Context (..), vanillaContext, stageContext,
+
+    -- * Expressions
+    getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
+
+    -- * Paths
+    contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile,
+    pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile,
+    pkgConfFile, objectPath
     ) where
 
 import GHC.Generics
 import Hadrian.Expression
 
 import Base
+import Oracles.PackageData
 import Oracles.Setting
 
 -- | Build context for a currently built 'Target'. We generate potentially
@@ -45,3 +54,91 @@ getWay = way <$> getContext
 -- | Get a list of configuration settings for the current stage.
 getStagedSettingList :: (Stage -> SettingList) -> Args Context b
 getStagedSettingList f = getSettingList . f =<< getStage
+
+-- | Get the build path of the current 'Context'.
+getBuildPath :: Expr Context b FilePath
+getBuildPath = expr . buildPath =<< getContext
+
+-- | Path to the directory containing build artefacts of a given 'Context'.
+buildPath :: Context -> Action FilePath
+buildPath context = buildRoot <&> (-/- contextDir context)
+
+-- | The directory in 'buildRoot' containing build artefacts of a given 'Context'.
+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
+
+-- | Path to inplace package configuration file of a given 'Context'.
+pkgInplaceConfig :: Context -> Action FilePath
+pkgInplaceConfig context = do
+    path <- buildPath context
+    return $ path -/- "inplace-pkg-config"
+
+-- | Path to the @package-data.mk@ of a given 'Context'.
+pkgDataFile :: Context -> Action FilePath
+pkgDataFile context = do
+    path <- buildPath context
+    return $ path -/- "package-data.mk"
+
+-- | Path to the @setup-config@ of a given 'Context'.
+pkgSetupConfigFile :: Context -> Action FilePath
+pkgSetupConfigFile context = do
+    path <- buildPath context
+    return $ path -/- "setup-config"
+
+-- | Path to the haddock file of a given 'Context', e.g.:
+-- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
+pkgHaddockFile :: Context -> Action FilePath
+pkgHaddockFile context@Context {..} = do
+    path <- buildPath context
+    let name = pkgNameString package
+    return $ path -/- "doc/html" -/- name -/- name <.> "haddock"
+
+-- | Path to the library file of a given 'Context', e.g.:
+-- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
+pkgLibraryFile :: Context -> Action FilePath
+pkgLibraryFile context@Context {..} = do
+    extension <- libsuf way
+    pkgFile context "libHS" extension
+
+-- | Path to the auxiliary library file of a given 'Context', e.g.:
+-- @_build/stage1/compiler/build/libHSghc-8.1-0.a@.
+pkgLibraryFile0 :: Context -> Action FilePath
+pkgLibraryFile0 context@Context {..} = do
+    extension <- libsuf way
+    pkgFile context "libHS" ("-0" ++ extension)
+
+-- | Path to the GHCi library file of a given 'Context', e.g.:
+-- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
+pkgGhciLibraryFile :: Context -> Action FilePath
+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
+    let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
+              | otherwise       = inplacePackageDbPath
+    return $ dbDir -/- componentId <.> "conf"
+
+-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
+-- to its object file. For example:
+-- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
+-- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
+objectPath :: Context -> FilePath -> Action FilePath
+objectPath context@Context {..} src = do
+    isGenerated <- isGeneratedSource src
+    path        <- buildPath context
+    let extension = drop 1 $ takeExtension src
+        obj       = src -<.> osuf way
+        result | isGenerated          = obj
+               | "*hs*" ?== extension = path -/- obj
+               | otherwise            = path -/- extension -/- obj
+    return result
index ca8862e..8da4a6f 100644 (file)
@@ -16,8 +16,8 @@ module Expression (
     Context, vanillaContext, stageContext, Target,
 
     -- * Convenient accessors
-    getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
-    getInput, getOutput,
+    getBuildRoot, getBuildPath, getContext, getStage, getPackage, getBuilder,
+    getOutputs, getInputs, getWay, getInput, getOutput,
 
     -- * Re-exports
     module Base
@@ -27,7 +27,7 @@ import qualified Hadrian.Expression as H
 import Hadrian.Expression hiding (Expr, Predicate, Args)
 
 import Base
-import Context (Context, vanillaContext, stageContext, getStage, getPackage, getWay)
+import Context (Context, vanillaContext, stageContext, getBuildPath, getStage, getPackage, getWay)
 import Target hiding (builder, inputs, outputs)
 
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
index 9355cd0..6d49630 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 module GHC (
+    -- * GHC packages
     array, base, binary, bytestring, cabal, checkApiAnnotations, compareSizes,
     compiler, containers, deepseq, deriveConstants, directory, dllSplit, filepath,
     genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci,
@@ -8,14 +9,21 @@ module GHC (
     hpc, hpcBin, integerGmp, integerSimple, iservBin, libffi, mkUserGuidePart,
     parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
     terminfo, time, touchy, transformers, unlit, unix, win32, xhtml,
-    defaultKnownPackages, builderProvenance, programName, nonCabalContext,
-    nonHsMainPackage
+    defaultKnownPackages,
+
+    -- * Package information
+    builderProvenance, programName, nonCabalContext, nonHsMainPackage, autogenPath,
+
+    -- * RTS library
+    rtsContext, rtsBuildPath, rtsConfIn,
+
+    -- * Miscellaneous
+    ghcSplitPath, stripCmdPath, inplaceInstallPath
     ) where
 
-import Builder
+import Base
 import Context
-import Package
-import Stage
+import Oracles.Setting
 
 -- | These are all GHC packages we know about. Build rules will be generated for
 -- all of them. However, not all of these packages will be built. For example,
@@ -132,3 +140,55 @@ nonCabalContext Context {..} = (package `elem` [hp2ps, rts, touchy, unlit])
 -- | Some program packages should not be linked with Haskell main function.
 nonHsMainPackage :: Package -> Bool
 nonHsMainPackage = (`elem` [ghc, hp2ps, iservBin, touchy, unlit])
+
+-- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
+autogenPath :: Context -> Action FilePath
+autogenPath context@Context {..}
+    | isLibrary package   = autogen "build"
+    | package == ghc      = autogen "build/ghc"
+    | package == hpcBin   = autogen "build/hpc"
+    | package == iservBin = autogen "build/iserv"
+    | otherwise           = autogen $ "build" -/- pkgNameString package
+  where
+    autogen dir = buildPath context <&> (-/- dir -/- "autogen")
+
+-- | Given a 'Package', return the path where the corresponding program is
+-- installed. Most programs are installed in 'programInplacePath'.
+inplaceInstallPath :: Package -> FilePath
+inplaceInstallPath pkg
+    | pkg == touchy   = inplaceLibBinPath
+    | pkg == unlit    = inplaceLibBinPath
+    | pkg == iservBin = inplaceLibBinPath
+    | otherwise       = inplaceBinPath
+
+-- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
+-- generated in "Rules.Generators.GhcSplit".
+ghcSplitPath :: FilePath
+ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
+
+-- ref: mk/config.mk
+-- | Command line tool for stripping.
+stripCmdPath :: Action FilePath
+stripCmdPath = do
+    targetPlatform <- setting TargetPlatform
+    top <- topDirectory
+    case targetPlatform of
+        "x86_64-unknown-mingw32" ->
+             return (top -/- "inplace/mingw/bin/strip.exe")
+        "arm-unknown-linux" ->
+             return ":" -- HACK: from the make-based system, see the ref above
+        _ -> return "strip"
+
+-- TODO: Move to RTS-specific package?
+-- | RTS is considered a Stage1 package. This determines RTS build directory.
+rtsContext :: Context
+rtsContext = vanillaContext Stage1 rts
+
+-- | Path to the RTS build directory.
+rtsBuildPath :: Action FilePath
+rtsBuildPath = buildPath rtsContext
+
+-- | Path to RTS package configuration file, to be processed by HsCpp.
+rtsConfIn :: FilePath
+rtsConfIn = pkgPath rts -/- "package.conf.in"
+
index b781cdd..b0b7ad6 100644 (file)
@@ -13,7 +13,7 @@ module Hadrian.Expression (
     interpret, interpretInContext,
 
     -- * Convenient accessors
-    getContext, getBuilder, getOutputs, getInputs, getInput, getOutput
+    getBuildRoot, getContext, getBuilder, getOutputs, getInputs, getInput, getOutput
     ) where
 
 import Control.Monad.Extra
@@ -95,6 +95,10 @@ interpretInContext c = interpret $ target c
     (error "contextOnlyTarget: inputs not set" )
     (error "contextOnlyTarget: outputs not set")
 
+-- | Get the directory of build results.
+getBuildRoot :: Expr c b FilePath
+getBuildRoot = expr buildRoot
+
 -- | Get the current build 'Context'.
 getContext :: Expr c b c
 getContext = Expr $ asks Target.context
index 74c10b4..3fe389d 100644 (file)
@@ -6,11 +6,14 @@ module Hadrian.Utilities (
     quote, yesNo,
 
     -- * FilePath manipulation
-    unifyPath, (-/-), matchVersionedFilePath,
+    unifyPath, (-/-),
 
     -- * Accessing Shake's type-indexed map
     insertExtra, userSetting,
 
+    -- * Paths
+    BuildRoot (..), buildRoot, isGeneratedSource,
+
     -- * File system operations
     copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile,
     createDirectory, copyDirectory, moveDirectory, removeDirectory,
@@ -21,12 +24,14 @@ module Hadrian.Utilities (
     putProgressInfo, renderAction, renderProgram, renderLibrary, renderBox,
     renderUnicorn,
 
+    -- * Miscellaneous
+    (<&>),
+
     -- * Useful re-exports
     Dynamic, fromDynamic, toDyn, TypeRep, typeOf
     ) where
 
 import Control.Monad.Extra
-import Data.Char
 import Data.Dynamic (Dynamic, fromDynamic, toDyn)
 import Data.HashMap.Strict (HashMap)
 import Data.List.Extra
@@ -111,25 +116,6 @@ a  -/- b
 
 infixr 6 -/-
 
--- | Given a @prefix@ and a @suffix@ check whether a 'FilePath' matches the
--- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
--- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
---
--- @
--- 'matchVersionedFilePath' "foo/bar"  ".a" "foo/bar.a"     '==' 'True'
--- 'matchVersionedFilePath' "foo/bar"  ".a" "foo\bar.a"     '==' 'False'
--- 'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar.a"     '==' 'True'
--- 'matchVersionedFilePath' "foo/bar"  ""   "foo/bar.a"     '==' 'False'
--- 'matchVersionedFilePath' "foo/bar"  "a"  "foo/bar-0.1.a" '==' 'True'
--- 'matchVersionedFilePath' "foo/bar-" "a"  "foo/bar-0.1.a" '==' 'True'
--- 'matchVersionedFilePath' "foo/bar/" "a"  "foo/bar-0.1.a" '==' 'False'
--- @
-matchVersionedFilePath :: String -> String -> FilePath -> Bool
-matchVersionedFilePath prefix suffix filePath =
-    case stripPrefix prefix filePath >>= stripSuffix suffix of
-        Nothing      -> False
-        Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
-
 -- | Insert a value into Shake's type-indexed map.
 insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
 insertExtra value = Map.insert (typeOf value) (toDyn value)
@@ -142,6 +128,32 @@ userSetting defaultValue = do
     let maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
     return $ fromMaybe defaultValue maybeValue
 
+newtype BuildRoot = BuildRoot FilePath deriving Typeable
+
+-- | All build results are put into the 'buildRoot' directory.
+buildRoot :: Action FilePath
+buildRoot = do
+    BuildRoot path <- userSetting (BuildRoot "")
+    return path
+
+-- | A version of 'fmap' with flipped arguments. Useful for manipulating values
+-- in context, e.g. 'buildRoot', as in the example below.
+--
+-- @
+-- buildRoot <&> (-/- "dir") == fmap (-/- "dir") buildRoot
+-- @
+(<&>) :: Functor f => f a -> (a -> b) -> f b
+(<&>) = flip fmap
+
+infixl 1 <&>
+
+-- | Given a 'FilePath' to a source file, return 'True' if it is generated.
+-- The current implementation simply assumes that a file is generated if it
+-- lives in the 'buildRoot' directory. Since most files are not generated the
+-- test is usually very fast.
+isGeneratedSource :: FilePath -> Action Bool
+isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
+
 -- | Copy a file tracking the source. Create the target directory if missing.
 copyFile :: FilePath -> FilePath -> Action ()
 copyFile source target = do
@@ -162,7 +174,7 @@ copyFileUntracked source target = do
 -- | Transform a given file by applying a function to its contents.
 fixFile :: FilePath -> (String -> String) -> Action ()
 fixFile file f = do
-    putBuild $ "| Fix " ++ file
+    putProgressInfo $ "| Fix " ++ file
     contents <- liftIO $ IO.withFile file IO.ReadMode $ \h -> do
         old <- IO.hGetContents h
         let new = f old
@@ -173,7 +185,7 @@ fixFile file f = do
 -- | Make a given file executable by running the @chmod +x@ command.
 makeExecutable :: FilePath -> Action ()
 makeExecutable file = do
-    putBuild $ "| Make " ++ quote file ++ " executable."
+    putProgressInfo $ "| Make " ++ quote file ++ " executable."
     quietly $ cmd "chmod +x " [file]
 
 -- | Move a file. Note that we cannot track the source, because it is moved.
@@ -185,13 +197,13 @@ moveFile source target = do
 -- | Remove a file that doesn't necessarily exist.
 removeFile :: FilePath -> Action ()
 removeFile file = do
-    putBuild $ "| Remove file " ++ file
+    putProgressInfo $ "| Remove file " ++ file
     liftIO . whenM (IO.doesFileExist file) $ IO.removeFile file
 
 -- | Create a directory if it does not already exist.
 createDirectory :: FilePath -> Action ()
 createDirectory dir = do
-    putBuild $ "| Create directory " ++ dir
+    putProgressInfo $ "| Create directory " ++ dir
     liftIO $ IO.createDirectoryIfMissing True dir
 
 -- | Copy a directory. The contents of the source directory is untracked.
@@ -209,7 +221,7 @@ moveDirectory source target = do
 -- | Remove a directory that doesn't necessarily exist.
 removeDirectory :: FilePath -> Action ()
 removeDirectory dir = do
-    putBuild $ "| Remove directory " ++ dir
+    putProgressInfo $ "| Remove directory " ++ dir
     liftIO . whenM (IO.doesDirectoryExist dir) $ IO.removeDirectoryRecursive dir
 
 data UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)
index 22a2270..83ef3db 100644 (file)
@@ -3,6 +3,7 @@ module Main (main) where
 import Development.Shake
 import Hadrian.Utilities
 
+import qualified Base
 import qualified CommandLine
 import qualified Environment
 import qualified Rules
@@ -11,7 +12,6 @@ import qualified Rules.Install
 import qualified Rules.SourceDist
 import qualified Rules.Selftest
 import qualified Rules.Test
-import qualified Settings.Path
 import qualified UserSettings
 
 main :: IO ()
@@ -20,12 +20,15 @@ main = do
     -- Shake's type-indexed map 'shakeExtra'.
     argsMap <- CommandLine.cmdLineArgsMap
     let extra = insertExtra UserSettings.buildProgressColour
-              $ insertExtra UserSettings.successColour argsMap
+              $ insertExtra UserSettings.successColour
+              $ insertExtra UserSettings.userBuildRoot argsMap
+
+        BuildRoot buildRoot = UserSettings.userBuildRoot
 
         options :: ShakeOptions
         options = shakeOptions
             { shakeChange   = ChangeModtimeAndDigest
-            , shakeFiles    = Settings.Path.shakeFilesPath
+            , shakeFiles    = buildRoot -/- Base.shakeFilesDir
             , shakeProgress = progressSimple
             , shakeTimings  = True
             , shakeExtra    = extra }
index 57414ad..7823179 100644 (file)
@@ -6,8 +6,8 @@ import qualified Data.HashMap.Strict as Map
 
 import Base
 import Context
+import GHC
 import Oracles.PackageData
-import Settings.Path
 
 newtype ModuleFiles = ModuleFiles (Stage, Package)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
@@ -75,22 +75,25 @@ hsSources :: Context -> Action [FilePath]
 hsSources context = do
     let modFile (m, Nothing   ) = generatedFile context m
         modFile (m, Just file )
-            | takeExtension file `elem` haskellExtensions = file
+            | takeExtension file `elem` haskellExtensions = return file
             | otherwise = generatedFile context m
-    map modFile <$> contextFiles context
+    mapM modFile =<< contextFiles context
 
 -- | Find all Haskell object files for a given 'Context'. Note: this is a much
 -- simpler function compared to 'hsSources', because all object files live in
 -- the build directory regardless of whether they are generated or not.
 hsObjects :: Context -> Action [FilePath]
 hsObjects context = do
-    modules <- pkgDataList $ Modules (buildPath context)
+    path    <- buildPath context
+    modules <- pkgDataList (Modules path)
     -- GHC.Prim module is only for documentation, we do not actually build it.
-    return . map (objectPath context . moduleSource) $ filter (/= "GHC.Prim") modules
+    mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules)
 
 -- | Generated module files live in the 'Context' specific build directory.
-generatedFile :: Context -> String -> FilePath
-generatedFile context moduleName = buildPath context -/- moduleSource moduleName
+generatedFile :: Context -> String -> Action FilePath
+generatedFile context moduleName = do
+    path <- buildPath context
+    return $ path -/- moduleSource moduleName
 
 moduleSource :: String -> FilePath
 moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
@@ -98,7 +101,8 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
 -- | Module files for a given 'Context'.
 contextFiles :: Context -> Action [(String, Maybe FilePath)]
 contextFiles context@Context {..} = do
-    modules <- fmap sort . pkgDataList . Modules $ buildPath context
+    path    <- buildPath context
+    modules <- fmap sort . pkgDataList $ Modules path
     zip modules <$> askOracle (ModuleFiles (stage, package))
 
 -- | This is an important oracle whose role is to find and cache module source
@@ -116,10 +120,11 @@ moduleFilesOracle :: Rules ()
 moduleFilesOracle = void $ do
     void . addOracle $ \(ModuleFiles (stage, package)) -> do
         let context = vanillaContext stage package
-            path    = buildPath context
+        path    <- buildPath context
         srcDirs <-             pkgDataList $ SrcDirs path
         modules <- fmap sort . pkgDataList $ Modules path
-        let dirs = autogenPath context : map (pkgPath package -/-) srcDirs
+        autogen <- autogenPath context
+        let dirs = autogen : map (pkgPath package -/-) srcDirs
             modDirFiles = groupSort $ map decodeModule modules
         result <- concatForM dirs $ \dir -> do
             todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
@@ -142,9 +147,10 @@ moduleFilesOracle = void $ do
     generators <- newCache $ \(stage, package) -> do
         let context = vanillaContext stage package
         files <- contextFiles context
-        return $ Map.fromList [ (generatedFile context modName, src)
-                              | (modName, Just src) <- files
-                              , takeExtension src `notElem` haskellExtensions ]
+        list  <- sequence [ (,src) <$> (generatedFile context modName)
+                          | (modName, Just src) <- files
+                          , takeExtension src `notElem` haskellExtensions ]
+        return $ Map.fromList list
 
     addOracle $ \(Generator (stage, package, file)) ->
         Map.lookup file <$> generators (stage, package)
index d55a578..3a4e92a 100644 (file)
@@ -24,7 +24,6 @@ import qualified Rules.Perl
 import qualified Rules.Program
 import qualified Rules.Register
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
@@ -55,12 +54,14 @@ packageTargets stage pkg = do
     then return [] -- Skip inactive packages.
     else if isLibrary pkg
         then do -- Collect all targets of a library package.
-            ways <- interpretInContext context getLibraryWays
-            libs <- mapM (pkgLibraryFile . Context stage pkg) ways
-            docs <- interpretInContext context =<< buildHaddock <$> flavour
-            more <- libraryTargets context
-            return $ [ pkgSetupConfigFile context | nonCabalContext context ]
-                  ++ [ pkgHaddockFile     context | docs && stage == Stage1 ]
+            ways    <- interpretInContext context getLibraryWays
+            libs    <- mapM (pkgLibraryFile . Context stage pkg) ways
+            docs    <- interpretInContext context =<< buildHaddock <$> flavour
+            more    <- libraryTargets context
+            setup   <- pkgSetupConfigFile context
+            haddock <- pkgHaddockFile     context
+            return $ [ setup   | nonCabalContext context ]
+                  ++ [ haddock | docs && stage == Stage1 ]
                   ++ libs ++ more
         else -- The only target of a program package is the executable.
             fmap maybeToList . programPath =<< programContext stage pkg
index ddfd0f2..a9a9b51 100644 (file)
@@ -10,12 +10,11 @@ import Distribution.Verbosity
 import Base
 import GHC
 import Settings
-import Settings.Path
 
 cabalRules :: Rules ()
 cabalRules = do
     -- Cache boot package constraints (to be used in 'cabalArgs').
-    bootPackageConstraints %> \out -> do
+    "//" -/- bootPackageConstraints %> \out -> do
         bootPkgs <- stagePackages Stage0
         let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
         constraints <- forM (sort pkgs) $ \pkg -> do
@@ -25,10 +24,10 @@ cabalRules = do
                 version             = display . pkgVersion $ identifier
             return $ unPackageName (DP.pkgName identifier) ++ " == " ++ version
         writeFileChanged out . unlines $ constraints
-        putSuccess $ "| Successfully computed boot package constraints"
+        putSuccess $ "| Successfully generated boot package constraints"
 
     -- Cache package dependencies.
-    packageDependencies %> \out -> do
+    "//" -/- packageDependencies %> \out -> do
         pkgDeps <- forM (sort knownPackages) $ \pkg -> do
             exists <- doesFileExist $ pkgCabalFile pkg
             if not exists then return $ pkgNameString pkg
@@ -41,7 +40,7 @@ cabalRules = do
                     depNames = [ unPackageName name | Dependency name _ <- deps ]
                 return . unwords $ pkgNameString pkg : (sort depNames \\ [pkgNameString pkg])
         writeFileChanged out $ unlines pkgDeps
-        putSuccess $ "| Successfully computed package dependencies"
+        putSuccess $ "| Successfully generated package dependencies"
 
 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
 collectDeps Nothing = []
index a938be1..03d2d73 100644 (file)
@@ -1,20 +1,20 @@
 module Rules.Clean (clean, cleanSourceTree, cleanRules) where
 
 import Base
-import Settings.Path
-import UserSettings
 
 clean :: Action ()
 clean = do
     cleanSourceTree
     putBuild $ "| Remove Hadrian files..."
-    removeDirectory generatedPath
-    removeFilesAfter buildRootPath ["//*"]
+    path <- buildRoot
+    removeDirectory $ path -/- generatedDir
+    removeFilesAfter path ["//*"]
     putSuccess $ "| Done. "
 
 cleanSourceTree :: Action ()
 cleanSourceTree = do
-    forM_ [Stage0 ..] $ removeDirectory . (buildRootPath -/-) . stageString
+    path <- buildRoot
+    forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString
     removeDirectory inplaceBinPath
     removeDirectory inplaceLibPath
     removeDirectory "sdistprep"
index 746f723..9d979b5 100644 (file)
@@ -6,20 +6,20 @@ import Base
 import Context
 import Expression
 import Rules.Generate
-import Settings.Path
 import Target
 import Utilities
 
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context@Context {..} = do
-    let path            = buildPath context
-        nonHs extension = path -/- extension <//> "*" <.> osuf way
+    let dir             = "//" ++ contextDir context
+        nonHs extension = dir -/- extension <//> "*" <.> osuf way
         compile compiler obj2src obj = do
-            let src = obj2src context obj
+            src <- obj2src context obj
             need [src]
             needDependencies context src $ obj <.> "d"
             build $ target context (compiler stage) [src] [obj]
         compileHs = \[obj, _hi] -> do
+            path <- buildPath context
             (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
             need $ src : deps
             when (isLibrary package) $ need =<< return <$> pkgConfFile context
@@ -32,8 +32,8 @@ compilePackage rs context@Context {..} = do
         nonHs "s"   %> compile (Ghc CompileHs)       (obj2src "S"   $ const False     )
 
     -- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
-    [ path <//> "*" <.> suf way | suf <- [    osuf,     hisuf] ] &%> compileHs
-    [ path <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
+    [ dir <//> "*" <.> suf way | suf <- [    osuf,     hisuf] ] &%> compileHs
+    [ dir <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
 
 -- | Discover dependencies of a given source file by iteratively calling @gcc@
 -- in the @-MM -MG@ mode and building generated dependencies if they are missing
@@ -71,11 +71,13 @@ fullPathIfGenerated context file = interpretInContext context $ do
     generated <- generatedDependencies
     return $ find ((== file) . takeFileName) generated
 
-obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> FilePath
+obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> Action FilePath
 obj2src extension isGenerated context@Context {..} obj
-    | isGenerated src = src
-    | otherwise       = pkgPath package ++ suffix
+    | isGenerated src = return src
+    | otherwise       = (pkgPath package ++) <$> suffix
   where
     src    = obj -<.> extension
-    suffix = fromMaybe ("Cannot determine source for " ++ obj)
-           $ stripPrefix (buildPath context -/- extension) src
+    suffix = do
+        path <- buildPath context
+        return $ fromMaybe ("Cannot determine source for " ++ obj)
+               $ stripPrefix (path -/- extension) src
index de1a991..801069b 100644 (file)
@@ -6,20 +6,17 @@ import Expression
 import GHC
 import Oracles.Setting
 import Rules.Generate
-import Settings.Path
 import Target
 import Utilities
 
 -- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
 buildPackageData :: Context -> Rules ()
 buildPackageData context@Context {..} = do
-    let path      = buildPath context
+    let dir       = "//" ++ contextDir context
         cabalFile = pkgCabalFile package
         configure = pkgPath package -/- "configure"
-        dataFile  = pkgDataFile context
-        setupConfigFile = pkgSetupConfigFile context
-
-    [dataFile, setupConfigFile] &%> \(mk:setupConfig:_) -> do
+    -- TODO: Get rid of hardcoded file paths.
+    [dir -/- "package-data.mk", dir -/- "setup-config"] &%> \[mk, setupConfig] -> do
         -- Make sure all generated dependencies are in place before proceeding.
         orderOnly =<< interpretInContext context generatedDependencies
 
@@ -33,22 +30,27 @@ buildPackageData context@Context {..} = do
         build $ target context GhcCabal [cabalFile] [mk, setupConfig]
         postProcessPackageData context mk
 
-    pkgInplaceConfig context %> \conf -> do
+    -- TODO: Get rid of hardcoded file paths.
+    dir -/- "inplace-pkg-config" %> \conf -> do
+        path     <- buildPath context
+        dataFile <- pkgDataFile context
         need [dataFile] -- ghc-cabal builds inplace package configuration file
         if package == rts
         then do
+            genPath <- buildRoot <&> (-/- generatedDir)
+            rtsPath <- rtsBuildPath
             need [rtsConfIn]
             build $ target context HsCpp [rtsConfIn] [conf]
             fixFile conf $ unlines
                          . map
                          ( replace "\"\"" ""
-                         . replace "rts/dist/build" rtsBuildPath
-                         . replace "includes/dist-derivedconstants/header" generatedPath )
+                         . replace "rts/dist/build" rtsPath
+                         . replace "includes/dist-derivedconstants/header" genPath )
                          . lines
         else
             fixFile conf $ unlines . map (replace (path </> "build") path) . lines
 
-    priority 2.0 $ when (nonCabalContext context) $ dataFile %>
+    priority 2.0 $ when (nonCabalContext context) $ dir -/- "package-data.mk" %>
         generatePackageData context
 
 generatePackageData :: Context -> FilePath -> Action ()
@@ -57,6 +59,7 @@ generatePackageData context@Context {..} file = do
     asmSrcs <- packageAsmSources package
     cSrcs   <- packageCSources   package
     cmmSrcs <- packageCmmSources package
+    genPath <- buildRoot <&> (-/- generatedDir)
     let pkgKey = if isLibrary package then "COMPONENT_ID = " else "PROGNAME = "
     writeFileChanged file . unlines $
         [ pkgKey ++ pkgNameString package                                   ] ++
@@ -64,7 +67,7 @@ generatePackageData context@Context {..} file = do
         [ "C_SRCS = "   ++ unwords cSrcs                                    ] ++
         [ "CMM_SRCS = " ++ unwords cmmSrcs                                  ] ++
         [ "DEP_EXTRA_LIBS = m"                 | package == hp2ps           ] ++
-        [ "CC_OPTS = -I" ++ generatedPath      | package `elem` [hp2ps, rts]] ++
+        [ "CC_OPTS = -I" ++ genPath            | package `elem` [hp2ps, rts]] ++
         [ "MODULES = Main"                     | package == ghcCabal        ] ++
         [ "HS_SRC_DIRS = ."                    | package == ghcCabal        ] ++
         [ "SYNOPSIS = Bootstrapped ghc-cabal." | package == ghcCabal        ]
@@ -75,11 +78,12 @@ packageCSources pkg
     | pkg /= rts = getDirectoryFiles (pkgPath pkg) ["*.c"]
     | otherwise  = do
         windows <- windowsHost
+        rtsPath <- rtsBuildPath
         sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) .
             map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++
                               [ if windows then "win32" else "posix"     ]
-        return $ sources ++ [ rtsBuildPath -/- "c/sm/Evac_thr.c" ]
-                         ++ [ rtsBuildPath -/- "c/sm/Scav_thr.c" ]
+        return $ sources ++ [ rtsPath -/- "c/sm/Evac_thr.c" ]
+                         ++ [ rtsPath -/- "c/sm/Scav_thr.c" ]
 
 packageAsmSources :: Package -> Action [FilePath]
 packageAsmSources pkg
@@ -94,8 +98,9 @@ packageCmmSources :: Package -> Action [FilePath]
 packageCmmSources pkg
     | pkg /= rts = return []
     | otherwise  = do
+        rtsPath <- rtsBuildPath
         sources <- getDirectoryFiles (pkgPath pkg) ["*.cmm"]
-        return $ sources ++ [ rtsBuildPath -/- "cmm/AutoApply.cmm" ]
+        return $ sources ++ [ rtsPath -/- "cmm/AutoApply.cmm" ]
 
 -- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
 -- 1) Drop lines containing '$'. For example, get rid of
@@ -110,7 +115,8 @@ postProcessPackageData :: Context -> FilePath -> Action ()
 postProcessPackageData context@Context {..} file = do
     top     <- topDirectory
     cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"]
-    let len = length (pkgPath package) + length (top -/- buildPath context) + 2
+    path    <- buildPath context
+    let len = length (pkgPath package) + length (top -/- path) + 2
     fixFile file $ unlines
                  . (++ ["CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) ])
                  . map (drop len) . filter ('$' `notElem`) . lines
index 6931194..4ac21a6 100644 (file)
@@ -8,13 +8,12 @@ import Context
 import Expression
 import Oracles.ModuleFiles
 import Rules.Generate
-import Settings.Path
 import Target
 import Utilities
 
 buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
 buildPackageDependencies rs context@Context {..} =
-    buildPath context -/- ".dependencies" %> \deps -> do
+    "//" ++ contextDir context -/- ".dependencies" %> \deps -> do
         srcs <- hsSources context
         need srcs
         orderOnly =<< interpretInContext context generatedDependencies
index 842eb4c..b10756e 100644 (file)
@@ -1,45 +1,46 @@
-module Rules.Documentation (buildPackageDocumentation) where
+module Rules.Documentation (buildPackageDocumentation, haddockDependencies) where
 
 import Base
 import Context
-import Expression hiding (way)
 import Flavour
 import GHC
 import Oracles.ModuleFiles
 import Oracles.PackageData
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
 haddockHtmlLib :: FilePath
 haddockHtmlLib = "inplace/lib/html/haddock-util.js"
 
+haddockDependencies :: Context -> Action [FilePath]
+haddockDependencies context = do
+    path     <- buildPath context
+    depNames <- pkgDataList $ DepNames path
+    sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
+             | Just depPkg <- map (findKnownPackage . PackageName) depNames
+             , depPkg /= rts ]
+
 -- Note: this build rule creates plenty of files, not just the .haddock one.
 -- All of them go into the 'doc' subdirectory. Pedantically tracking all built
 -- files in the Shake database seems fragile and unnecessary.
 buildPackageDocumentation :: Context -> Rules ()
-buildPackageDocumentation context@Context {..} =
-    let haddockFile = pkgHaddockFile context
-    in when (stage == Stage1) $ do
-        haddockFile %> \file -> do
-            srcs <- hsSources context
-            deps <- map PackageName <$> interpretInContext context (getPkgDataList DepNames)
-            let haddocks = [ pkgHaddockFile $ vanillaContext Stage1 depPkg
-                           | Just depPkg <- map findKnownPackage deps
-                           , depPkg /= rts ]
-            need $ srcs ++ haddocks ++ [haddockHtmlLib]
+buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do
+    "//" ++ contextDir context ++ "//*.haddock" %> \file -> do
+        srcs     <- hsSources context
+        haddocks <- haddockDependencies context
+        need $ srcs ++ haddocks ++ [haddockHtmlLib]
 
-            -- Build Haddock documentation
-            -- TODO: pass the correct way from Rules via Context
-            dynamicPrograms <- dynamicGhcPrograms <$> flavour
-            let haddockWay = if dynamicPrograms then dynamic else vanilla
-            build $ target (context {way = haddockWay}) Haddock srcs [file]
+        -- Build Haddock documentation
+        -- TODO: pass the correct way from Rules via Context
+        dynamicPrograms <- dynamicGhcPrograms <$> flavour
+        let haddockWay = if dynamicPrograms then dynamic else vanilla
+        build $ target (context {way = haddockWay}) Haddock srcs [file]
 
-        when (package == haddock) $ haddockHtmlLib %> \_ -> do
-            let dir = takeDirectory haddockHtmlLib
-            liftIO $ removeFiles dir ["//*"]
-            copyDirectory "utils/haddock/haddock-api/resources/html" dir
+    when (package == haddock) $ haddockHtmlLib %> \_ -> do
+        let dir = takeDirectory haddockHtmlLib
+        liftIO $ removeFiles dir ["//*"]
+        copyDirectory "utils/haddock/haddock-api/resources/html" dir
 
 -- # Make the haddocking depend on the library .a file, to ensure
 -- # that we wait until the library is fully built before we haddock it
index b02b654..a3e95f1 100644 (file)
@@ -11,9 +11,9 @@ import GHC
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
+import Rules.Gmp
 import Rules.Libffi
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
@@ -25,10 +25,10 @@ primopsSource :: FilePath
 primopsSource = "compiler/prelude/primops.txt.pp"
 
 primopsTxt :: Stage -> FilePath
-primopsTxt stage = buildPath (vanillaContext stage compiler) -/- "primops.txt"
+primopsTxt stage = contextDir (vanillaContext stage compiler) -/- "primops.txt"
 
 platformH :: Stage -> FilePath
-platformH stage = buildPath (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
+platformH stage = contextDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
 
 isGeneratedCFile :: FilePath -> Bool
 isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"]
@@ -37,7 +37,7 @@ isGeneratedCmmFile :: FilePath -> Bool
 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
 
 includesDependencies :: [FilePath]
-includesDependencies = fmap (generatedPath -/-)
+includesDependencies = fmap (generatedDir -/-)
     [ "ghcautoconf.h"
     , "ghcplatform.h"
     , "ghcversion.h" ]
@@ -45,11 +45,11 @@ includesDependencies = fmap (generatedPath -/-)
 ghcPrimDependencies :: Expr [FilePath]
 ghcPrimDependencies = do
     stage <- getStage
-    let path = buildPath $ vanillaContext stage ghcPrim
+    path  <- expr $ buildPath (vanillaContext stage ghcPrim)
     return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
 
 derivedConstantsDependencies :: [FilePath]
-derivedConstantsDependencies = fmap (generatedPath -/-)
+derivedConstantsDependencies = fmap (generatedDir -/-)
     [ "DerivedConstants.h"
     , "GHCConstantsHaskellExports.hs"
     , "GHCConstantsHaskellType.hs"
@@ -57,15 +57,18 @@ derivedConstantsDependencies = fmap (generatedPath -/-)
 
 compilerDependencies :: Expr [FilePath]
 compilerDependencies = do
-    stage  <- getStage
-    intLib <- expr (integerLibrary =<< flavour)
-    let path = buildPath $ vanillaContext stage compiler
-    mconcat [ return [platformH stage]
-            , return includesDependencies
-            , return derivedConstantsDependencies
-            , notStage0 ? intLib == integerGmp ? return [gmpLibraryH]
-            , notStage0 ? return libffiDependencies
-            , return $ fmap (path -/-)
+    root    <- getBuildRoot
+    stage   <- getStage
+    intLib  <- expr (integerLibrary =<< flavour)
+    ghcPath <- expr $ buildPath (vanillaContext stage compiler)
+    gmpPath <- expr gmpBuildPath
+    rtsPath <- expr rtsBuildPath
+    mconcat [ return [root -/- platformH stage]
+            , return ((root -/-) <$> includesDependencies)
+            , return ((root -/-) <$> derivedConstantsDependencies)
+            , notStage0 ? intLib == integerGmp ? return [gmpPath -/- gmpLibraryH]
+            , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)
+            , return $ fmap (ghcPath -/-)
                   [ "primop-can-fail.hs-incl"
                   , "primop-code-size.hs-incl"
                   , "primop-commutable.hs-incl"
@@ -83,13 +86,15 @@ compilerDependencies = do
                   , "primop-vector-uniques.hs-incl" ] ]
 
 generatedDependencies :: Expr [FilePath]
-generatedDependencies = mconcat
-    [ package compiler ? compilerDependencies
-    , package ghcPrim  ? ghcPrimDependencies
-    , package rts      ? return (libffiDependencies
-        ++ includesDependencies
-        ++ derivedConstantsDependencies)
-    , stage0 ? return includesDependencies ]
+generatedDependencies = do
+    root    <- getBuildRoot
+    rtsPath <- expr rtsBuildPath
+    mconcat [ package compiler ? compilerDependencies
+            , package ghcPrim  ? ghcPrimDependencies
+            , package rts      ? return (fmap (rtsPath -/-) libffiDependencies
+                ++ fmap (root -/-) includesDependencies
+                ++ fmap (root -/-) derivedConstantsDependencies)
+            , stage0 ? return (fmap (root -/-) includesDependencies) ]
 
 generate :: FilePath -> Context -> Expr String -> Action ()
 generate file context expr = do
@@ -99,8 +104,8 @@ generate file context expr = do
 
 generatePackageCode :: Context -> Rules ()
 generatePackageCode context@(Context stage pkg _) =
-    let path        = buildPath context
-        generated f = (path ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
+    let dir         = contextDir context
+        generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
         go gen file = generate file context gen
     in do
         generated ?> \file -> do
@@ -112,52 +117,57 @@ generatePackageCode context@(Context stage pkg _) =
             whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
 
         priority 2.0 $ do
-            when (pkg == compiler) $ path -/- "Config.hs" %> go generateConfigHs
-            when (pkg == ghcPkg) $ path -/- "Version.hs" %> go generateVersionHs
+            when (pkg == compiler) $ "//" -/- dir -/- "Config.hs" %> go generateConfigHs
+            when (pkg == ghcPkg) $ "//" -/- dir -/- "Version.hs" %> go generateVersionHs
 
         -- TODO: needing platformH is ugly and fragile
         when (pkg == compiler) $ do
-            primopsTxt stage %> \file -> do
-                need $ [platformH stage, primopsSource] ++ includesDependencies
+            "//" ++ primopsTxt stage %> \file -> do
+                root <- buildRoot
+                need $ [root -/- platformH stage, primopsSource]
+                    ++ fmap (root -/-) includesDependencies
                 build $ target context HsCpp [primopsSource] [file]
 
-            platformH stage %> go generateGhcBootPlatformH
+            "//" ++ platformH stage %> go generateGhcBootPlatformH
 
         -- TODO: why different folders for generated files?
-        fmap (path -/-)
+        priority 2.0 $ fmap (("//" ++ dir) -/-)
             [ "GHC/Prim.hs"
             , "GHC/PrimopWrappers.hs"
             , "*.hs-incl" ] |%> \file -> do
-                need [primopsTxt stage]
-                build $ target context GenPrimopCode [primopsTxt stage] [file]
+                root <- buildRoot
+                need [root -/- primopsTxt stage]
+                build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
 
-        when (pkg == rts) $ path -/- "cmm/AutoApply.cmm" %> \file ->
+        when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file ->
             build $ target context GenApply [] [file]
 
 copyRules :: Rules ()
 copyRules = do
-    (inplaceLibPath -/- "ghc-usage.txt")     <~ "driver"
-    (inplaceLibPath -/- "ghci-usage.txt"  )  <~ "driver"
-    (inplaceLibPath -/- "platformConstants") <~ generatedPath
-    (inplaceLibPath -/- "settings")          <~ "."
-    (inplaceLibPath -/- "template-hsc.h")    <~ pkgPath hsc2hs
-    rtsBuildPath -/- "c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
-    rtsBuildPath -/- "c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
+    (inplaceLibPath -/- "ghc-usage.txt")     <~ return "driver"
+    (inplaceLibPath -/- "ghci-usage.txt"  )  <~ return "driver"
+    (inplaceLibPath -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir))
+    (inplaceLibPath -/- "settings")          <~ return "."
+    (inplaceLibPath -/- "template-hsc.h")    <~ return (pkgPath hsc2hs)
+    "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
+    "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
   where
-    file <~ dir = file %> copyFile (dir -/- takeFileName file)
+    pattern <~ mdir = pattern %> \file -> do
+        dir <- mdir
+        copyFile (dir -/- takeFileName file) file
 
 generateRules :: Rules ()
 generateRules = do
-    (generatedPath -/- "ghcautoconf.h") <~ generateGhcAutoconfH
-    (generatedPath -/- "ghcplatform.h") <~ generateGhcPlatformH
-    (generatedPath -/-  "ghcversion.h") <~ generateGhcVersionH
+    priority 2.0 $ ("//" ++ generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH
+    priority 2.0 $ ("//" ++ generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH
+    priority 2.0 $ ("//" ++ generatedDir -/-  "ghcversion.h") <~ generateGhcVersionH
 
     ghcSplitPath %> \_ -> do
         generate ghcSplitPath emptyTarget generateGhcSplit
         makeExecutable ghcSplitPath
 
     -- TODO: simplify, get rid of fake rts context
-    generatedPath ++ "//*" %> \file -> do
+    "//" ++ generatedDir ++ "//*" %> \file -> do
         withTempDir $ \dir -> build $
             target rtsContext DeriveConstants [] [file, dir]
   where
index 765dbeb..5e2a73a 100644 (file)
@@ -1,10 +1,11 @@
-module Rules.Gmp (gmpRules) where
+module Rules.Gmp (
+    gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH, gmpBuildInfoPath
+    ) where
 
 import Base
+import Context
 import GHC
 import Oracles.Setting
-import Settings.Packages.IntegerGmp
-import Settings.Path
 import Target
 import Utilities
 
@@ -12,13 +13,30 @@ gmpBase :: FilePath
 gmpBase = pkgPath integerGmp -/- "gmp"
 
 gmpLibraryInTreeH :: FilePath
-gmpLibraryInTreeH = gmpBuildPath -/- "include/gmp.h"
+gmpLibraryInTreeH = "include/gmp.h"
 
 gmpLibrary :: FilePath
-gmpLibrary = gmpBuildPath -/- ".libs/libgmp.a"
+gmpLibrary = ".libs/libgmp.a"
 
-gmpMakefile :: FilePath
-gmpMakefile = gmpBuildPath -/- "Makefile"
+-- | GMP is considered a Stage1 package. This determines GMP build directory.
+gmpContext :: Context
+gmpContext = vanillaContext Stage1 integerGmp
+
+-- | Build directory for in-tree GMP library.
+gmpBuildPath :: Action FilePath
+gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
+
+-- | GMP library header, relative to 'gmpBuildPath'.
+gmpLibraryH :: FilePath
+gmpLibraryH = "include/ghc-gmp.h"
+
+-- | Directory for GMP library object files, relative to 'gmpBuildPath'.
+gmpObjectsDir :: FilePath
+gmpObjectsDir = "objs"
+
+-- | Path to the GMP library buildinfo file.
+gmpBuildInfoPath :: FilePath
+gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo"
 
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
@@ -28,7 +46,7 @@ configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
 gmpRules :: Rules ()
 gmpRules = do
     -- Copy appropriate GMP header and object files
-    gmpLibraryH %> \header -> do
+    "//" ++ gmpLibraryH %> \header -> do
         windows  <- windowsHost
         configMk <- readFile' $ gmpBase -/- "config.mk"
         if not windows && -- TODO: We don't use system GMP on Windows. Fix?
@@ -38,34 +56,43 @@ gmpRules = do
             copyFile (gmpBase -/- "ghc-gmp.h") header
         else do
             putBuild "| No GMP library/framework detected; in tree GMP will be built"
-            need [gmpLibrary]
-            createDirectory gmpObjects
-            build $ target gmpContext (Ar Stage1) [gmpLibrary] [gmpObjects]
-            copyFile (gmpBuildPath -/- "gmp.h") header
-            copyFile (gmpBuildPath -/- "gmp.h") gmpLibraryInTreeH
+            gmpPath <- gmpBuildPath
+            need [gmpPath -/- gmpLibrary]
+            createDirectory (gmpPath -/- gmpObjectsDir)
+            build $ target gmpContext (Ar Stage1) [gmpPath -/- gmpLibrary   ]
+                                                  [gmpPath -/- gmpObjectsDir]
+            copyFile (gmpPath -/- "gmp.h") header
+            copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
 
     -- Build in-tree GMP library
-    gmpLibrary %> \lib -> do
-        build $ target gmpContext (Make gmpBuildPath) [gmpMakefile] [lib]
+    "//" ++ gmpLibrary %> \lib -> do
+        gmpPath <- gmpBuildPath
+        build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
         putSuccess "| Successfully built custom library 'gmp'"
 
-    -- In-tree GMP header is built in the gmpLibraryH rule
-    gmpLibraryInTreeH %> \_ -> need [gmpLibraryH]
+    -- In-tree GMP header is built by the gmpLibraryH rule
+    "//" ++ gmpLibraryInTreeH %> \_ -> do
+        gmpPath <- gmpBuildPath
+        need [gmpPath -/- gmpLibraryH]
 
     -- This causes integerGmp package to be configured, hence creating the files
-    [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ ->
-        need [pkgDataFile gmpContext]
+    [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do
+        dataFile <- pkgDataFile gmpContext
+        need [dataFile]
 
     -- Run GMP's configure script
-    gmpMakefile %> \mk -> do
-        env <- configureEnvironment
+    -- TODO: Get rid of hard-coded @gmp@.
+    "//gmp/Makefile" %> \mk -> do
+        env     <- configureEnvironment
+        gmpPath <- gmpBuildPath
         need [mk <.> "in"]
         buildWithCmdOptions env $
-            target gmpContext (Configure gmpBuildPath) [mk <.> "in"] [mk]
+            target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
 
     -- Extract in-tree GMP sources and apply patches
-    gmpMakefile <.> "in" %> \_ -> do
-        removeDirectory gmpBuildPath
+    "//gmp/Makefile.in" %> \_ -> do
+        gmpPath <- gmpBuildPath
+        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.
         -- That's because the doc/ directory contents are under the GFDL,
@@ -88,4 +115,4 @@ gmpRules = do
                     ++ "-nodoc (found: " ++ name ++ ")."
                 libName = unpack $ stripSuffix "-nodoc" name
 
-            moveDirectory (tmp -/- libName) gmpBuildPath
+            moveDirectory (tmp -/- libName) gmpPath
index 7d5245c..1d0cd9e 100644 (file)
@@ -14,7 +14,6 @@ import Rules.Libffi
 import Rules.Wrappers
 import Settings
 import Settings.Packages.Rts
-import Settings.Path
 import Target
 import Utilities
 
@@ -124,6 +123,9 @@ withLatestBuildStage pkg m = do
       Just stage -> m stage
       Nothing    -> return ()
 
+pkgConfInstallPath :: Action FilePath
+pkgConfInstallPath = buildPath (vanillaContext Stage0 rts) <&> (-/- "package.conf.install")
+
 -- ref: rules/manual-package-conf.mk
 -- TODO: Should we use a temporary file instead of pkgConfInstallPath?
 -- | Install @package.conf.install@ for each package. Note that it will be
@@ -131,21 +133,23 @@ withLatestBuildStage pkg m = do
 installPackageConf :: Action ()
 installPackageConf = do
     let context = vanillaContext Stage0 rts
-    liftIO $ IO.createDirectoryIfMissing True (takeDirectory pkgConfInstallPath)
+    confPath <- pkgConfInstallPath
+    liftIO $ IO.createDirectoryIfMissing True (takeDirectory confPath)
     build $ target context HsCpp [ pkgPath rts -/- "package.conf.in" ]
-                                 [ pkgConfInstallPath <.> "raw" ]
+                                 [ confPath <.> "raw" ]
     Stdout content <- cmd "grep" [ "-v", "^#pragma GCC"
-                                 , pkgConfInstallPath <.> "raw" ]
+                                 , confPath <.> "raw" ]
     withTempFile $ \tmp -> do
         liftIO $ writeFile tmp content
         Stdout result <- cmd "sed" [ "-e", "s/\"\"//g", "-e", "s/:[   ]*,/: /g", tmp ]
-        liftIO $ writeFile pkgConfInstallPath result
+        liftIO $ writeFile confPath result
 
 -- ref: ghc.mk
 -- | Install packages to @prefix/lib@.
 installPackages :: Action ()
 installPackages = do
-    need [pkgConfInstallPath]
+    confPath <- pkgConfInstallPath
+    need [confPath]
 
     ghcLibDir <- installGhcLibDir
     binDir    <- setting InstallBinDir
@@ -167,8 +171,8 @@ installPackages = do
     forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir
 
     -- HACK (issue #327)
-    let ghcBootPlatformHeader =
-            buildPath (vanillaContext Stage1 compiler) -/- "ghc_boot_platform.h"
+    ghcBootPlatformHeader <-
+        buildPath (vanillaContext Stage1 compiler) <&> (-/- "ghc_boot_platform.h")
 
     copyFile ghcBootPlatformHeader (pkgPath compiler -/- "ghc_boot_platform.h")
 
@@ -182,7 +186,7 @@ installPackages = do
             withLatestBuildStage pkg $ \stage -> do
                 let context = vanillaContext stage pkg
                 top <- topDirectory
-                let installDistDir = top -/- buildPath context
+                installDistDir <- (top -/-) <$> buildPath context
                 need =<< packageTargets stage pkg
                 docDir <- installDocDir
                 ghclibDir <- installGhcLibDir
@@ -222,14 +226,14 @@ installPackages = do
     -- TODO: Extend GhcPkg builder args to support --global-package-db
     unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db"
                                    , installedPackageConf, "update"
-                                   , pkgConfInstallPath ]
+                                   , confPath ]
 
     forM_ installLibPkgs $ \pkg@Package{..} -> do
         when (isLibrary pkg) $
             withLatestBuildStage pkg $ \stage -> do
                 let context = vanillaContext stage pkg
                 top <- topDirectory
-                let installDistDir = top -/- buildPath context
+                installDistDir <- (top -/-) <$> buildPath context
                 -- TODO: better reference to the built inplace binary path
                 let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal"
                 pref   <- setting InstallPrefix
@@ -289,7 +293,7 @@ includeHSubdirs = [".", "rts", "rts/prof", "rts/storage", "stg"]
 
 -- ref: includes/ghc.mk
 -- | Install header files to @prefix/lib/ghc-<version>/include@.
-installIncludes ::Action ()
+installIncludes :: Action ()
 installIncludes = do
     ghclibDir <- installGhcLibDir
     let ghcheaderDir = ghclibDir -/- "include"
@@ -299,9 +303,11 @@ installIncludes = do
         headers <- getDirectoryFiles ("includes" -/- dir) ["*.h"]
         installHeader (map (("includes" -/- dir) -/-) headers)
                       (destDir ++ ghcheaderDir -/- dir ++ "/")
-    installHeader (includesDependencies ++
-                   [generatedPath -/- "DerivedConstants.h"] ++
-                   libffiDependencies)
+    root    <- buildRoot
+    rtsPath <- rtsBuildPath
+    installHeader (fmap (root -/-) includesDependencies ++
+                   [root -/- generatedDir -/- "DerivedConstants.h"] ++
+                   fmap (rtsPath -/-) libffiDependencies)
                   (destDir ++ ghcheaderDir ++ "/")
   where
     installHeader = installData -- they share same arguments
index 1506c0a..9c9637b 100644 (file)
@@ -1,4 +1,4 @@
-module Rules.Libffi (libffiRules, libffiDependencies) where
+module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
 
 import Hadrian.Utilities
 
@@ -7,14 +7,19 @@ import Settings.Packages.Rts
 import Target
 import Utilities
 
+-- | Libffi is considered a Stage1 package. This determines its build directory.
+libffiContext :: Context
+libffiContext = vanillaContext Stage1 libffi
+
+-- | Build directory for in-tree Libffi library.
+libffiBuildPath :: Action FilePath
+libffiBuildPath = buildPath libffiContext
+
 libffiDependencies :: [FilePath]
-libffiDependencies = (rtsBuildPath -/-) <$> [ "ffi.h", "ffitarget.h" ]
+libffiDependencies = ["ffi.h", "ffitarget.h"]
 
 libffiLibrary :: FilePath
-libffiLibrary = libffiBuildPath -/- "inst/lib/libffi.a"
-
-libffiMakefile :: FilePath
-libffiMakefile = libffiBuildPath -/- "Makefile"
+libffiLibrary = "inst/lib/libffi.a"
 
 fixLibffiMakefile :: FilePath -> String -> String
 fixLibffiMakefile top =
@@ -41,51 +46,62 @@ configureEnvironment = do
 
 libffiRules :: Rules ()
 libffiRules = do
-    (libffiLibrary : libffiDependencies) &%> \_ -> do
+    fmap ("//rts" -/-) libffiDependencies &%> \_ -> do
+        libffiPath <- libffiBuildPath
+        need [libffiPath -/- libffiLibrary]
+
+    "//" ++ libffiLibrary %> \_ -> do
         useSystemFfi <- flag UseSystemFfi
+        rtsPath      <- rtsBuildPath
         if useSystemFfi
         then do
             ffiIncludeDir <- setting FfiIncludeDir
             putBuild "| System supplied FFI library will be used"
             forM_ ["ffi.h", "ffitarget.h"] $ \file ->
-                copyFile (ffiIncludeDir -/- file) (rtsBuildPath -/- file)
+                copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
             putSuccess $ "| Successfully copied system FFI library header files"
         else do
-            build $ target libffiContext (Make libffiBuildPath) [] []
+            libffiPath <- libffiBuildPath
+            build $ target libffiContext (Make libffiPath) [] []
 
-            hs <- getDirectoryFiles "" [libffiBuildPath -/- "inst/lib/*/include/*"]
+            hs <- getDirectoryFiles "" [libffiPath -/- "inst/lib/*/include/*"]
             forM_ hs $ \header ->
-                copyFile header (rtsBuildPath -/- takeFileName header)
+                copyFile header (rtsPath -/- takeFileName header)
 
             ways <- interpretInContext libffiContext (getLibraryWays <> getRtsWays)
-            forM_ (nubOrd ways) $ \way ->
-                copyFileUntracked libffiLibrary =<< rtsLibffiLibrary way
+            forM_ (nubOrd ways) $ \way -> do
+                rtsLib <- rtsLibffiLibrary way
+                copyFileUntracked (libffiPath -/- libffiLibrary) rtsLib
 
             putSuccess $ "| Successfully built custom library 'libffi'"
 
-    libffiMakefile <.> "in" %> \mkIn -> do
-        removeDirectory libffiBuildPath
+    "//libffi/Makefile.in" %> \mkIn -> do
+        libffiPath <- libffiBuildPath
+        removeDirectory libffiPath
         tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
                <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
 
         need [tarball]
         let libname = dropExtension . dropExtension $ takeFileName tarball
 
-        removeDirectory (buildRootPath -/- libname)
+        root <- buildRoot
+        removeDirectory (root -/- libname)
         -- TODO: Simplify.
         actionFinally (do
-            build $ target libffiContext Tar [tarball] [buildRootPath]
-            moveDirectory (buildRootPath -/- libname) libffiBuildPath) $
-                removeFiles buildRootPath [libname <//> "*"]
+            build $ target libffiContext Tar [tarball] [root]
+            moveDirectory (root -/- libname) libffiPath) $
+                removeFiles root [libname <//> "*"]
 
         top <- topDirectory
         fixFile mkIn (fixLibffiMakefile top)
 
-    libffiMakefile %> \mk -> do
+    -- TODO: Get rid of hard-coded @libffi@.
+    "//libffi/Makefile" %> \mk -> do
         need [mk <.> "in"]
+        libffiPath <- libffiBuildPath
         forM_ ["config.guess", "config.sub"] $ \file ->
-            copyFile file (libffiBuildPath -/- file)
+            copyFile file (libffiPath -/- file)
 
         env <- configureEnvironment
         buildWithCmdOptions env $
-            target libffiContext (Configure libffiBuildPath) [mk <.> "in"] [mk]
+            target libffiContext (Configure libffiPath) [mk <.> "in"] [mk]
index 1d010b4..f4259fb 100644 (file)
@@ -13,8 +13,8 @@ import GHC
 import Oracles.ModuleFiles
 import Oracles.PackageData
 import Oracles.Setting
+import Rules.Gmp
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
@@ -37,7 +37,7 @@ libraryObjects context@Context{..} = do
 
 buildDynamicLib :: Context -> Rules ()
 buildDynamicLib context@Context{..} = do
-    let libPrefix = buildPath context -/- "libHS" ++ pkgNameString package
+    let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgNameString package
     -- OS X
     libPrefix ++ "*.dylib" %> buildDynamicLibUnix
     -- Linux
@@ -52,8 +52,8 @@ buildDynamicLib context@Context{..} = do
 
 buildPackageLibrary :: Context -> Rules ()
 buildPackageLibrary context@Context {..} = do
-    let libPrefix  = buildPath context -/- "libHS" ++ pkgNameString package
-    matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
+    let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgNameString package
+    libPrefix ++ "*" ++ (waySuffix way <.> "a") %> \a -> do
         objs <- libraryObjects context
         asuf <- libsuf way
         let isLib0 = ("//*-0" ++ asuf) ?== a
@@ -68,8 +68,8 @@ buildPackageLibrary context@Context {..} = do
 
 buildPackageGhciLibrary :: Context -> Rules ()
 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
-    let libPrefix = buildPath context -/- "HS" ++ pkgNameString package
-    matchVersionedFilePath libPrefix (waySuffix way <.> "o") ?> \obj -> do
+    let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgNameString package
+    libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
         objs <- allObjects context
         need objs
         build $ target context Ld objs [obj]
@@ -79,15 +79,18 @@ allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
 
 nonHsObjects :: Context -> Action [FilePath]
 nonHsObjects context = do
-    let path = buildPath context
+    path    <- buildPath context
     cObjs   <- cObjects context
-    cmmObjs <- map (objectPath context) <$> pkgDataList (CmmSrcs path)
+    cmmSrcs <- pkgDataList (CmmSrcs path)
+    cmmObjs <- mapM (objectPath context) cmmSrcs
     eObjs   <- extraObjects context
     return $ cObjs ++ cmmObjs ++ eObjs
 
 cObjects :: Context -> Action [FilePath]
 cObjects context = do
-    objs <- map (objectPath context) <$> pkgDataList (CSrcs $ buildPath context)
+    path <- buildPath context
+    srcs <- pkgDataList (CSrcs path)
+    objs <- mapM (objectPath context) srcs
     return $ if way context == threaded
         then objs
         else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
@@ -95,6 +98,7 @@ cObjects context = do
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
     | package context == integerGmp = do
-        need [gmpLibraryH]
-        map unifyPath <$> getDirectoryFiles "" [gmpObjects -/- "*.o"]
+        gmpPath <- gmpBuildPath
+        need [gmpPath -/- gmpLibraryH]
+        map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
     | otherwise         = return []
index 6ca514f..141715e 100644 (file)
@@ -11,7 +11,6 @@ import Oracles.PackageData
 import Oracles.Setting
 import Rules.Wrappers
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
@@ -22,7 +21,7 @@ buildProgram rs context@Context {..} = when (isProgram package) $ do
             latest <- latestBuildStage package -- fromJust below is safe
             return $ if package == ghc then stage else fromJust latest
 
-    buildPath context -/- programName context <.> exe %> \bin -> do
+    "//" ++ contextDir context -/- programName context <.> exe %> \bin -> do
         context' <- programContext stage package
         buildBinaryAndWrapper rs context' bin
 
@@ -98,8 +97,9 @@ buildBinary rs context@Context {..} bin = do
             when (stage > Stage0) $ do
                 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
                 needLibrary [ rtsContext { way = w } | w <- ways ]
-            let path = buildPath context
-            cObjs  <- map (objectPath context) <$> pkgDataList (CSrcs path)
+            path   <- buildPath context
+            cSrcs  <- pkgDataList (CSrcs path)
+            cObjs  <- mapM (objectPath context) cSrcs
             hsObjs <- hsObjects context
             return $ cObjs ++ hsObjs
                   ++ [ path -/- "Paths_hsc2hs.o"  | package == hsc2hs  ]
index 88518f2..261f142 100644 (file)
@@ -3,25 +3,44 @@ module Rules.Register (registerPackage) where
 import Base
 import Context
 import GHC
-import Settings.Path
 import Target
 import Utilities
 
+-- TODO: Simplify.
 -- | Build rules for registering packages and initialising package databases
 -- by running the @ghc-pkg@ utility.
 registerPackage :: [(Resource, Int)] -> Context -> Rules ()
-registerPackage rs context@Context {..} = when (stage <= Stage1) $ do
-    let confIn = pkgInplaceConfig context
-        dir    = inplacePackageDbDirectory stage
+registerPackage rs context@Context {..} = do
+    when (stage == Stage0) $ do
+        -- Packages @ghc-boot@ and @ghc-boot-th@ both match the @ghc-boot*@
+        -- pattern, therefore we need to use priorities to match the right rule.
+        -- TODO: Get rid of this hack.
+        priority (fromIntegral . length $ pkgNameString package) $
+            "//" ++ stage0PackageDbDir -/- pkgNameString package ++ "*.conf" %>
+                buildConf rs context
 
-    matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
-        need [confIn]
-        buildWithResources rs $
-            target context (GhcPkg Update stage) [confIn] [conf]
+        when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %>
+            buildStamp rs context
 
-    when (package == ghc) $ packageDbStamp stage %> \stamp -> do
-        removeDirectory dir
-        buildWithResources rs $
-            target (vanillaContext stage ghc) (GhcPkg Init stage) [] [dir]
-        writeFileLines stamp []
-        putSuccess $ "| Successfully initialised " ++ dir
+    when (stage == Stage1) $ do
+        priority (fromIntegral . length $ pkgNameString package) $
+            inplacePackageDbPath -/- pkgNameString package ++ "*.conf" %>
+                buildConf rs context
+
+        when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %>
+            buildStamp rs context
+
+buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
+buildConf rs context@Context {..} conf = do
+    confIn <- pkgInplaceConfig context
+    need [confIn]
+    buildWithResources rs $ target context (GhcPkg Update stage) [confIn] [conf]
+
+buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
+buildStamp rs Context {..} stamp = do
+    let path = takeDirectory stamp
+    removeDirectory path
+    buildWithResources rs $
+        target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
+    writeFileLines stamp []
+    putSuccess $ "| Successfully initialised " ++ path
index 692c8e9..f1f78bf 100644 (file)
@@ -26,7 +26,6 @@ selftestRules =
         testBuilder
         testChunksOfSize
         testLookupAll
-        testMatchVersionedFilePath
         testModuleName
         testPackages
         testWay
@@ -63,22 +62,6 @@ testLookupAll = do
     extras :: Gen [Int]
     extras = vector 20
 
-testMatchVersionedFilePath :: Action ()
-testMatchVersionedFilePath = do
-    putBuild $ "==== matchVersionedFilePath"
-    test $ matchVersionedFilePath "foo/bar"  ".a" "foo/bar.a"     == True
-    test $ matchVersionedFilePath "foo/bar"  ".a" "foo\\bar.a"    == False
-    test $ matchVersionedFilePath "foo/bar"  "a"  "foo/bar.a"     == True
-    test $ matchVersionedFilePath "foo/bar"  ""   "foo/bar.a"     == False
-    test $ matchVersionedFilePath "foo/bar"  "a"  "foo/bar-0.1.a" == True
-    test $ matchVersionedFilePath "foo/bar-" "a"  "foo/bar-0.1.a" == True
-    test $ matchVersionedFilePath "foo/bar/" "a"  "foo/bar-0.1.a" == False
-
-    test $ \prefix suffix -> forAll versions $ \version ->
-        matchVersionedFilePath prefix suffix (prefix ++ version ++ suffix)
-  where
-    versions = listOf . elements $ '-' : '.' : ['0'..'9']
-
 testModuleName :: Action ()
 testModuleName = do
     putBuild $ "==== Encode/decode module name"
index c1b5c6c..4c2f8ad 100644 (file)
@@ -7,7 +7,6 @@ import GHC
 import Oracles.Flag
 import Oracles.Setting
 import Settings
-import Settings.Path
 import Target
 import Utilities
 
index ae98c79..d6eeb1b 100644 (file)
@@ -5,19 +5,17 @@ module Rules.Wrappers (
 import Hadrian.Oracles.Path
 
 import Base
+import Context
 import Expression
 import GHC
 import Oracles.Setting
 import Settings
-import Settings.Install
-import Settings.Path
 
--- | Wrapper is an expression depending on the 'FilePath' to the
--- | library path and name of the wrapped binary.
-data WrappedBinary = WrappedBinary {
-  binaryLibPath :: FilePath,
-  binaryName    :: String
-}
+-- | Wrapper is an expression depending on (i) the 'FilePath' to the library and
+-- (ii) the name of the wrapped binary.
+data WrappedBinary = WrappedBinary
+    { binaryLibPath :: FilePath
+    , binaryName    :: String }
 
 type Wrapper = WrappedBinary -> Expr String
 
@@ -53,16 +51,15 @@ installRunGhcWrapper WrappedBinary{..} = do
 inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
 inplaceGhcPkgWrapper WrappedBinary{..} = do
     expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    stage <- getStage
-    top   <- expr topDirectory
-    -- Use the package configuration for the next stage in the wrapper.
-    -- The wrapper is generated in StageN, but used in StageN+1.
-    let packageDb = top -/- inplacePackageDbDirectory (succ stage)
+    top <- expr topDirectory
+    -- The wrapper is generated in StageN, but used in StageN+1. Therefore, we
+    -- always use the inplace package database, located at 'inplacePackageDbPath',
+    -- which is used in Stage1 and later.
     bash <- expr bashPath
     return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-          ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
+        [ "#!" ++ bash
+        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++
+          " --global-package-db " ++ top -/- inplacePackageDbPath ++ " ${1+\"$@\"}" ]
 
 installGhcPkgWrapper :: WrappedBinary -> Expr String
 installGhcPkgWrapper WrappedBinary{..} = do
@@ -71,7 +68,7 @@ installGhcPkgWrapper WrappedBinary{..} = do
     top   <- expr topDirectory
     -- Use the package configuration for the next stage in the wrapper.
     -- The wrapper is generated in StageN, but used in StageN+1.
-    let packageDb = installPackageDbDirectory binaryLibPath top (succ stage)
+    packageDb <- expr $ installPackageDbPath binaryLibPath top (succ stage)
     bash <- expr bashPath
     return $ unlines
         [ "#!"++bash
@@ -130,7 +127,7 @@ iservBinWrapper WrappedBinary{..} = do
                                         m <- expr $ latestBuildStage p
                                         return $ fmap (\s -> vanillaContext s p) m
                                    ) pkgs
-    let buildPaths = map buildPath contexts
+    buildPaths <- expr $ mapM buildPath contexts
     return $ unlines
         [ "#!/bin/bash"
         , "export DYLD_LIBRARY_PATH=\"" ++ intercalate ":" buildPaths ++
@@ -157,3 +154,11 @@ installWrappers :: [(Context, Wrapper)]
 installWrappers = wrappersCommon ++
                   [ (vanillaContext Stage0 ghcPkg, installGhcPkgWrapper)
                   , (vanillaContext Stage1 runGhc, installRunGhcWrapper) ]
+
+-- | In the final installation path specified by @DEST@, there is another
+-- @package.conf.d@ different from 'inplacePackageDbPath' defined in "Base".
+installPackageDbPath :: FilePath -> FilePath -> Stage -> Action FilePath
+installPackageDbPath _ top Stage0 = do
+    path <- buildRoot
+    return $ top -/- path -/- "stage0/bootstrapping.conf"
+installPackageDbPath libdir _ _ = return $ libdir -/- "package.conf.d"
index 5523020..2b4b0ef 100644 (file)
@@ -1,9 +1,8 @@
 module Settings (
     getArgs, getPackages, getLibraryWays, getRtsWays, flavour, knownPackages,
-    findKnownPackage, getPkgData, getPkgDataList, isLibrary,
-    getBuildPath, stagePackages, builderPath,
-    getBuilderPath, isSpecified, latestBuildStage, programPath, programContext,
-    integerLibraryName, destDir, pkgConfInstallPath, stage1Only, buildDll0
+    findKnownPackage, getPkgData, getPkgDataList, isLibrary, stagePackages,
+    builderPath, getBuilderPath, isSpecified, latestBuildStage, programPath,
+    programContext, integerLibraryName, destDir, stage1Only, buildDll0
     ) where
 
 import Hadrian.Oracles.KeyValue
@@ -22,7 +21,6 @@ import Settings.Flavours.Performance
 import Settings.Flavours.Profiled
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
-import Settings.Path
 import UserSettings
 
 getArgs :: Args
@@ -40,9 +38,6 @@ getPackages = expr flavour >>= packages
 stagePackages :: Stage -> Action [Package]
 stagePackages stage = interpretInContext (stageContext stage) getPackages
 
-getBuildPath :: Expr FilePath
-getBuildPath = buildPath <$> getContext
-
 getPkgData :: (FilePath -> PackageData) -> Expr String
 getPkgData key = expr . pkgData . key =<< getBuildPath
 
@@ -144,13 +139,11 @@ latestBuildStage pkg = do
 programPath :: Context -> Action (Maybe FilePath)
 programPath context@Context {..} = do
     maybeLatest <- latestBuildStage package
+    path        <- buildPath context
     return $ do
         install <- (\l -> l == stage || package == ghc) <$> maybeLatest
-        let path = if install then inplaceInstallPath package else buildPath context
-        return $ path -/- programName context <.> exe
-
-pkgConfInstallPath :: FilePath
-pkgConfInstallPath = buildPath (vanillaContext Stage0 rts) -/- "package.conf.install"
+        let installPath = if install then inplaceInstallPath package else path
+        return $ installPath -/- programName context <.> exe
 
 -- TODO: Set this from command line
 -- | Stage1Only flag.
index d8f843a..39d27b5 100644 (file)
@@ -7,30 +7,29 @@ module Settings.Builders.Common (
     module Oracles.PackageData,
     module Oracles.Setting,
     module Settings,
-    module Settings.Path,
     module UserSettings,
     cIncludeArgs, ldArgs, cArgs, cWarnings, bootPackageDatabaseArgs
     ) where
 
 import Base
-import Context (getStagedSettingList)
+import Context hiding (stage, package, way)
 import Expression
 import GHC
 import Oracles.Flag
 import Oracles.PackageData
 import Oracles.Setting
 import Settings
-import Settings.Path
 import UserSettings
 
 cIncludeArgs :: Args
 cIncludeArgs = do
     pkg     <- getPackage
+    root    <- getBuildRoot
     path    <- getBuildPath
     incDirs <- getPkgDataList IncludeDirs
     depDirs <- getPkgDataList DepIncludeDirs
     mconcat [ arg "-Iincludes"
-            , arg $ "-I" ++ generatedPath
+            , arg $ "-I" ++ root -/- generatedDir
             , arg $ "-I" ++ path
             , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ]
             , pure [ "-I" ++       unifyPath dir | dir <- depDirs ] ]
@@ -52,9 +51,13 @@ cWarnings = do
 
 bootPackageDatabaseArgs :: Args
 bootPackageDatabaseArgs = do
+    root  <- getBuildRoot
     stage <- getStage
-    expr $ need [packageDbStamp stage]
+    let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
+              | otherwise       = inplacePackageDbPath
+    expr $ need [dbDir -/- packageDbStamp]
     stage0 ? do
-        path   <- expr topDirectory
+        top    <- expr topDirectory
+        root   <- getBuildRoot
         prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
-        arg $ prefix ++ path -/- inplacePackageDbDirectory Stage0
+        arg $ prefix ++ top -/- root -/- stage0PackageDbDir
index 40a3657..93225b5 100644 (file)
@@ -1,21 +1,25 @@
 module Settings.Builders.Configure (configureBuilderArgs) where
 
+import Rules.Gmp
+import Rules.Libffi
 import Settings.Builders.Common
 
 configureBuilderArgs :: Args
-configureBuilderArgs = mconcat
-    [ builder (Configure gmpBuildPath) ? do
-        hostPlatform  <- getSetting HostPlatform
-        buildPlatform <- getSetting BuildPlatform
-        pure [ "--enable-shared=no"
-             , "--host=" ++ hostPlatform
-             , "--build=" ++ buildPlatform ]
+configureBuilderArgs = do
+    gmpPath    <- expr gmpBuildPath
+    libffiPath <- expr libffiBuildPath
+    mconcat [ builder (Configure gmpPath) ? do
+                hostPlatform  <- getSetting HostPlatform
+                buildPlatform <- getSetting BuildPlatform
+                pure [ "--enable-shared=no"
+                     , "--host=" ++ hostPlatform
+                     , "--build=" ++ buildPlatform ]
 
-    , builder (Configure libffiBuildPath) ? do
-        top            <- expr topDirectory
-        targetPlatform <- getSetting TargetPlatform
-        pure [ "--prefix=" ++ top -/- libffiBuildPath -/- "inst"
-             , "--libdir=" ++ top -/- libffiBuildPath -/- "inst/lib"
-             , "--enable-static=yes"
-             , "--enable-shared=no" -- TODO: add support for yes
-             , "--host=" ++ targetPlatform ] ]
+            , builder (Configure libffiPath) ? do
+                top            <- expr topDirectory
+                targetPlatform <- getSetting TargetPlatform
+                pure [ "--prefix=" ++ top -/- libffiPath -/- "inst"
+                     , "--libdir=" ++ top -/- libffiPath -/- "inst/lib"
+                     , "--enable-static=yes"
+                     , "--enable-shared=no" -- TODO: add support for yes
+                     , "--host=" ++ targetPlatform ] ]
index 2933793..b8846be 100644 (file)
@@ -23,13 +23,14 @@ deriveConstantsBuilderArgs = builder DeriveConstants ? do
         , arg "--target-os", arg =<< getSetting TargetOs ]
 
 includeCcArgs :: Args
-includeCcArgs = mconcat
-    [ cArgs
-    , cWarnings
-    , getSettingList $ ConfCcArgs Stage1
-    , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
-    , arg "-Irts"
-    , arg "-Iincludes"
-    , arg $ "-I" ++ generatedPath
-    , notM ghcWithSMP ? arg "-DNOSMP"
-    , arg "-fcommon" ]
+includeCcArgs = do
+    root <- getBuildRoot
+    mconcat [ cArgs
+            , cWarnings
+            , getSettingList $ ConfCcArgs Stage1
+            , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
+            , arg "-Irts"
+            , arg "-Iincludes"
+            , arg $ "-I" ++ root -/- generatedDir
+            , notM ghcWithSMP ? arg "-DNOSMP"
+            , arg "-fcommon" ]
index d939c6f..8b8bc92 100644 (file)
@@ -3,6 +3,7 @@ module Settings.Builders.Ghc (
     ) where
 
 import Flavour
+import Rules.Gmp
 import Settings.Builders.Common
 
 ghcBuilderArgs :: Args
@@ -130,15 +131,16 @@ includeGhcArgs :: Args
 includeGhcArgs = do
     pkg     <- getPackage
     path    <- getBuildPath
+    root    <- getBuildRoot
     context <- getContext
     srcDirs <- getPkgDataList SrcDirs
+    autogen <- expr $ autogenPath context
     mconcat [ arg "-i"
             , arg $ "-i" ++ path
-            , arg $ "-i" ++ autogenPath context
+            , arg $ "-i" ++ autogen
             , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ]
             , cIncludeArgs
-            , arg $      "-I" ++ generatedPath
-            , arg $ "-optc-I" ++ generatedPath
+            , arg $      "-I" ++ root -/- generatedDir
+            , arg $ "-optc-I" ++ root -/- generatedDir
             , (not $ nonCabalContext context) ?
-              pure [ "-optP-include"
-                   , "-optP" ++ autogenPath context -/- "cabal_macros.h" ] ]
+              pure [ "-optP-include", "-optP" ++ autogen -/- "cabal_macros.h" ] ]
index 9d6ab17..a792437 100644 (file)
@@ -12,10 +12,11 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
     verbosity <- expr getVerbosity
     top       <- expr topDirectory
     context   <- getContext
+    path      <- getBuildPath
     when (package context /= deriveConstants) $ expr (need inplaceLibCopyTargets)
     mconcat [ arg "configure"
             , arg =<< pkgPath <$> getPackage
-            , arg $ top -/- buildPath context
+            , arg $ top -/- path
             , dll0Args
             , withStaged $ Ghc CompileHs
             , withStaged (GhcPkg Update)
@@ -34,10 +35,10 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
 
 ghcCabalHsColourBuilderArgs :: Args
 ghcCabalHsColourBuilderArgs = builder GhcCabalHsColour ? do
-    path    <- pkgPath <$> getPackage
+    srcPath <- pkgPath <$> getPackage
     top     <- expr topDirectory
-    context <- getContext
-    pure [ "hscolour", path, top -/- buildPath context ]
+    path    <- getBuildPath
+    pure [ "hscolour", srcPath, top -/- path ]
 
 -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
 -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
@@ -62,14 +63,15 @@ libraryArgs = do
 -- TODO: LD_OPTS?
 configureArgs :: Args
 configureArgs = do
-    top <- expr topDirectory
+    top  <- expr topDirectory
+    root <- getBuildRoot
     let conf key expr = do
             values <- unwords <$> expr
             not (null values) ?
                 arg ("--configure-option=" ++ key ++ "=" ++ values)
         cFlags   = mconcat [ remove ["-Werror"] cArgs
                            , getStagedSettingList ConfCcArgs
-                           , arg $ "-I" ++ top -/- generatedPath ]
+                           , arg $ "-I" ++ top -/- root -/- generatedDir ]
         ldFlags  = ldArgs  <> (getStagedSettingList ConfGccLinkerArgs)
         cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs)
     cldFlags <- unwords <$> (cFlags <> ldFlags)
@@ -88,11 +90,14 @@ configureArgs = do
 
 packageConstraints :: Args
 packageConstraints = stage0 ? do
-    constraints <- expr . readFileLines $ bootPackageConstraints
+    path <- getBuildRoot <&> (-/- bootPackageConstraints)
+    constraints <- expr $ readFileLines path
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args
-cppArgs = arg $ "-I" ++ generatedPath
+cppArgs = do
+    root <- getBuildRoot
+    arg $ "-I" ++ root -/- generatedDir
 
 withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
index 0b9d6e4..ba705c6 100644 (file)
@@ -8,8 +8,10 @@ ghcPkgBuilderArgs = mconcat
 
     , builder (GhcPkg Update) ? do
         verbosity <- expr getVerbosity
+        context   <- getContext
+        config    <- expr $ pkgInplaceConfig context
         mconcat [ arg "update"
                 , arg "--force"
                 , verbosity < Chatty ? arg "-v0"
                 , bootPackageDatabaseArgs
-                , arg . pkgInplaceConfig =<< getContext ] ]
+                , arg config ] ]
index 5353e00..e8aeee4 100644 (file)
@@ -2,6 +2,7 @@ module Settings.Builders.Haddock (haddockBuilderArgs) where
 
 import Hadrian.Utilities
 
+import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
 
@@ -19,8 +20,9 @@ haddockBuilderArgs = builder Haddock ? do
     version  <- getPkgData Version
     synopsis <- getPkgData Synopsis
     deps     <- getPkgDataList Deps
-    depNames <- getPkgDataList DepNames
-    hVersion <- expr . pkgData . Version $ buildPath (vanillaContext Stage2 haddock)
+    haddocks <- expr . haddockDependencies =<< getContext
+    progPath <- expr $ buildPath (vanillaContext Stage2 haddock)
+    hVersion <- expr $ pkgData (Version progPath)
     ghcOpts  <- haddockGhcArgs
     mconcat
         [ arg $ "--odir=" ++ takeDirectory output
@@ -35,10 +37,7 @@ haddockBuilderArgs = builder Haddock ? do
         , map ("--hide=" ++) <$> getPkgDataList HiddenModules
         , pure [ "--read-interface=../" ++ dep
                  ++ ",../" ++ dep ++ "/src/%{MODULE/./-}.html\\#%{NAME},"
-                 ++ pkgHaddockFile (vanillaContext Stage1 depPkg)
-               | (dep, depName) <- zip deps depNames
-               , Just depPkg <- [findKnownPackage $ PackageName depName]
-               , depPkg /= rts ]
+                 ++ haddock | (dep, haddock) <- zip deps haddocks ]
         , pure [ "--optghc=" ++ opt | opt <- ghcOpts ]
         , isSpecified HsColour ?
           pure [ "--source-module=src/%{MODULE/./-}.html"
index 0707e49..aeb5255 100644 (file)
@@ -4,11 +4,13 @@ import Settings.Builders.Common
 
 hsCppBuilderArgs :: Args
 hsCppBuilderArgs = builder HsCpp ? do
-    stage <- getStage
+    stage   <- getStage
+    root    <- getBuildRoot
+    ghcPath <- expr $ buildPath (vanillaContext stage compiler)
     mconcat [ getSettingList HsCppArgs
             , arg "-P"
             , arg "-Iincludes"
-            , arg $ "-I" ++ generatedPath
-            , arg $ "-I" ++ buildPath (vanillaContext stage compiler)
+            , arg $ "-I" ++ root -/- generatedDir
+            , arg $ "-I" ++ ghcPath
             , arg "-x", arg "c"
             , arg =<< getInput ]
index 54ca1fc..6185f6b 100644 (file)
@@ -34,14 +34,15 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
 
 getCFlags :: Expr [String]
 getCFlags = do
-    context   <- getContext
+    context <- getContext
+    autogen <- expr $ autogenPath context
     mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
             , getStagedSettingList ConfCppArgs
             , cIncludeArgs
             , getPkgDataList CppArgs
             , getPkgDataList DepCcArgs
             , cWarnings
-            , arg "-include", arg $ autogenPath context -/- "cabal_macros.h" ]
+            , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
 
 getLFlags :: Expr [String]
 getLFlags = do
index b3c04c1..5a89921 100644 (file)
@@ -1,12 +1,16 @@
 module Settings.Builders.Make (makeBuilderArgs) where
 
+import Rules.Gmp
+import Rules.Libffi
 import Settings.Builders.Common
 
 makeBuilderArgs :: Args
 makeBuilderArgs = do
-    threads <- shakeThreads <$> (expr getShakeOptions)
+    threads    <- shakeThreads <$> (expr getShakeOptions)
+    gmpPath    <- expr gmpBuildPath
+    libffiPath <- expr libffiBuildPath
     let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
     mconcat
-        [ builder (Make gmpBuildPath     ) ? pure ["MAKEFLAGS=-j" ++ t]
-        , builder (Make libffiBuildPath  ) ? pure ["MAKEFLAGS=-j" ++ t, "install"]
+        [ builder (Make gmpPath          ) ? pure ["MAKEFLAGS=-j" ++ t]
+        , builder (Make libffiPath       ) ? pure ["MAKEFLAGS=-j" ++ t, "install"]
         , builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"] ]
diff --git a/src/Settings/Install.hs b/src/Settings/Install.hs
deleted file mode 100644 (file)
index 086cfa2..0000000
+++ /dev/null
@@ -1,11 +0,0 @@
-module Settings.Install (installPackageDbDirectory) where
-
-import Expression
-import UserSettings
-
--- | In the final installation path specified by "DEST", there is another package.conf.d,
--- different from packageDbDirectory in Settings.Path.
--- It is used by installGhcPkgWrapper
-installPackageDbDirectory :: FilePath -> FilePath -> Stage -> FilePath
-installPackageDbDirectory _ top Stage0 = top -/- buildRootPath -/- "stage0/bootstrapping.conf"
-installPackageDbDirectory libdir _ _   = libdir -/- "package.conf.d"
index 716e4e7..fd6b485 100644 (file)
@@ -1,14 +1,13 @@
 module Settings.Packages.Ghc (ghcPackageArgs) where
 
+import Context (buildPath)
 import GHC
 import Expression
 import Oracles.Setting
-import Settings.Path
 
 ghcPackageArgs :: Args
 ghcPackageArgs = package ghc ? do
     stage <- getStage
-    mconcat [ builder Ghc ? arg ("-I" ++ buildPath (vanillaContext stage compiler))
-
-            , builder GhcCabal ?
-              ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" ]
+    path  <- expr $ buildPath (vanillaContext stage compiler)
+    mconcat [ builder Ghc      ? arg ("-I" ++ path)
+            , builder GhcCabal ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" ]
index 964d2f6..3fdc5d6 100644 (file)
@@ -1,10 +1,10 @@
-module Settings.Packages.IntegerGmp (integerGmpPackageArgs, gmpBuildPath) where
+module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where
 
 import Base
 import Expression
 import GHC
 import Oracles.Setting
-import Settings.Path
+import Rules.Gmp
 
 -- TODO: Is this needed?
 -- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
@@ -12,7 +12,8 @@ import Settings.Path
 -- endif
 integerGmpPackageArgs :: Args
 integerGmpPackageArgs = package integerGmp ? do
-    let includeGmp = "-I" ++ gmpBuildPath -/- "include"
+    path <- expr gmpBuildPath
+    let includeGmp = "-I" ++ path -/- "include"
     gmpIncludeDir <- getSetting GmpIncludeDir
     gmpLibDir     <- getSetting GmpLibDir
     mconcat [ builder Cc ? arg includeGmp
index 8d2ff14..fe490dd 100644 (file)
@@ -6,7 +6,6 @@ import GHC
 import Oracles.Flag
 import Oracles.Setting
 import Settings
-import Settings.Path
 
 rtsLibffiLibraryName :: Action FilePath
 rtsLibffiLibraryName = do
@@ -19,9 +18,10 @@ rtsLibffiLibraryName = do
 
 rtsLibffiLibrary :: Way -> Action FilePath
 rtsLibffiLibrary way = do
-    name <- rtsLibffiLibraryName
-    suf  <- libsuf way
-    return $ rtsBuildPath -/- "lib" ++ name ++ suf
+    name    <- rtsLibffiLibraryName
+    suf     <- libsuf way
+    rtsPath <- rtsBuildPath
+    return $ rtsPath -/- "lib" ++ name ++ suf
 
 rtsPackageArgs :: Args
 rtsPackageArgs = package rts ? do
diff --git a/src/Settings/Path.hs b/src/Settings/Path.hs
deleted file mode 100644 (file)
index df30ad2..0000000
+++ /dev/null
@@ -1,245 +0,0 @@
-module Settings.Path (
-    -- * Hadrian configuration and source files
-    shakeFilesPath, bootPackageConstraints, packageDependencies,
-
-    -- * Build artefacts
-    buildPath, stageDirectory, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
-    pkgLibraryFile0, pkgGhciLibraryFile, generatedPath, inplacePackageDbDirectory,
-    pkgConfFile, packageDbStamp, objectPath, autogenPath, pkgInplaceConfig,
-    pkgSetupConfigFile,
-
-    -- * RTS library
-    rtsContext, rtsBuildPath, rtsConfIn,
-
-    -- * GMP library
-    gmpContext, gmpBuildPath, gmpObjects, gmpLibraryH, gmpBuildInfoPath,
-
-    -- * LibFFI library
-    libffiContext, libffiBuildPath,
-
-    -- * Installation
-    inplaceBinPath, inplaceLibBinPath, inplaceLibPath, inplaceInstallPath,
-    inplaceLibCopyTargets, templateHscPath,
-
-    -- * Miscellaneous
-    ghcSplitPath, stripCmdPath
-    ) where
-
-import Base
-import Context
-import GHC
-import Oracles.PackageData
-import Oracles.Setting
-import UserSettings
-
--- | Path to the directory containing the Shake database and other auxiliary
--- files generated by Hadrian.
-shakeFilesPath :: FilePath
-shakeFilesPath = buildRootPath -/- "hadrian"
-
--- | Boot package versions extracted from @.cabal@ files.
-bootPackageConstraints :: FilePath
-bootPackageConstraints = shakeFilesPath -/- "boot-package-constraints"
-
--- | Dependencies between packages extracted from @.cabal@ files.
-packageDependencies :: FilePath
-packageDependencies = shakeFilesPath -/- "package-dependencies"
-
--- | Path to the directory containing generated source files that are not
--- package-specific, e.g. @ghcplatform.h@.
-generatedPath :: FilePath
-generatedPath = buildRootPath -/- "generated"
-
--- | Relative path to the directory containing build artefacts of a given 'Stage'.
-stageDirectory :: Stage -> FilePath
-stageDirectory = stageString
-
--- | Path to the directory containing build artefacts of a given 'Context'.
-buildPath :: Context -> FilePath
-buildPath Context {..} = buildRootPath -/- stageDirectory stage -/- pkgPath package
-
--- | Path to inplace package configuration of a given 'Context'.
-pkgInplaceConfig :: Context -> FilePath
-pkgInplaceConfig context = buildPath context -/- "inplace-pkg-config"
-
--- | Path to the @package-data.mk@ of a given 'Context'.
-pkgDataFile :: Context -> FilePath
-pkgDataFile context = buildPath context -/- "package-data.mk"
-
--- | Path to the @setup-config@ of a given 'Context'.
-pkgSetupConfigFile :: Context -> FilePath
-pkgSetupConfigFile context = buildPath context -/- "setup-config"
-
--- | 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@Context {..} =
-    buildPath context -/- "doc/html" -/- name -/- name <.> "haddock"
-  where name = pkgNameString package
-
--- | Path to the library file of a given 'Context', e.g.:
--- "_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a".
-pkgLibraryFile :: Context -> Action FilePath
-pkgLibraryFile context@Context {..} = do
-    extension <- libsuf way
-    pkgFile context "libHS" extension
-
--- | Path to the auxiliary library file of a given 'Context', e.g.:
--- "_build/stage1/compiler/build/libHSghc-8.1-0.a".
-pkgLibraryFile0 :: Context -> Action FilePath
-pkgLibraryFile0 context@Context {..} = do
-    extension <- libsuf way
-    pkgFile context "libHS" ("-0" ++ extension)
-
--- | Path to the GHCi library file of a given 'Context', e.g.:
--- "_build/stage1/libraries/array/build/HSarray-0.5.1.0.o".
-pkgGhciLibraryFile :: Context -> Action FilePath
-pkgGhciLibraryFile context = pkgFile context "HS" ".o"
-
-pkgFile :: Context -> String -> String -> Action FilePath
-pkgFile context prefix suffix = do
-    let path = buildPath context
-    componentId <- pkgData $ ComponentId path
-    return $ path -/- prefix ++ componentId ++ suffix
-
--- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
-autogenPath :: Context -> FilePath
-autogenPath context@Context {..}
-    | isLibrary package   = autogen "build"
-    | package == ghc      = autogen "build/ghc"
-    | package == hpcBin   = autogen "build/hpc"
-    | package == iservBin = autogen "build/iserv"
-    | otherwise           = autogen $ "build" -/- pkgNameString package
-  where
-    autogen dir = buildPath context -/- dir -/- "autogen"
-
--- | Path to package database directory of a given 'Stage'. Note: StageN, N > 0,
--- share the same packageDbDirectory.
-inplacePackageDbDirectory :: Stage -> FilePath
-inplacePackageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
-inplacePackageDbDirectory _      = "inplace/lib/package.conf.d"
-
--- | We use a stamp file to track the existence of a package database.
-packageDbStamp :: Stage -> FilePath
-packageDbStamp stage = inplacePackageDbDirectory stage -/- ".stamp"
-
--- | Path to the configuration file of a given 'Context'.
-pkgConfFile :: Context -> Action FilePath
-pkgConfFile context@Context {..} = do
-    componentId <- pkgData . ComponentId $ buildPath context
-    return $ inplacePackageDbDirectory stage -/- componentId <.> "conf"
-
--- | Given a 'FilePath' to a source file, return 'True' if it is generated.
--- The current implementation simply assumes that a file is generated if it
--- lives in 'buildRootPath'. Since most files are not generated the test is
--- usually very fast.
-isGeneratedSource :: FilePath -> Bool
-isGeneratedSource = (buildRootPath `isPrefixOf`)
-
--- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
--- to its object file. For example:
--- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
--- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
-objectPath :: Context -> FilePath -> FilePath
-objectPath context@Context {..} src
-    | isGeneratedSource src = obj
-    | "*hs*" ?== extension  = buildPath context -/- obj
-    | otherwise             = buildPath context -/- extension -/- obj
-  where
-    extension = drop 1 $ takeExtension src
-    obj       = src -<.> osuf way
-
--- | RTS is considered a Stage1 package. This determines RTS build directory.
-rtsContext :: Context
-rtsContext = vanillaContext Stage1 rts
-
--- | Path to the RTS build directory.
-rtsBuildPath :: FilePath
-rtsBuildPath = buildPath rtsContext
-
--- | Path to RTS package configuration file, to be processed by HsCpp.
-rtsConfIn :: FilePath
-rtsConfIn = pkgPath rts -/- "package.conf.in"
-
--- | GMP is considered a Stage1 package. This determines GMP build directory.
-gmpContext :: Context
-gmpContext = vanillaContext Stage1 integerGmp
-
--- | Build directory for in-tree GMP library.
-gmpBuildPath :: FilePath
-gmpBuildPath = buildRootPath -/- stageDirectory (stage gmpContext) -/- "gmp"
-
--- | Path to the GMP library header.
-gmpLibraryH :: FilePath
-gmpLibraryH = gmpBuildPath -/- "include/ghc-gmp.h"
-
--- | Path to the GMP library object files.
-gmpObjects :: FilePath
-gmpObjects = gmpBuildPath -/- "objs"
-
--- | Path to the GMP library buildinfo file.
-gmpBuildInfoPath :: FilePath
-gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo"
-
--- | Libffi is considered a Stage1 package. This determines its build directory.
-libffiContext :: Context
-libffiContext = vanillaContext Stage1 libffi
-
--- | Build directory for in-tree Libffi library.
-libffiBuildPath :: FilePath
-libffiBuildPath = buildPath libffiContext
-
--- | Directory for binaries that are built "in place".
-inplaceBinPath :: FilePath
-inplaceBinPath = "inplace/bin"
-
--- | Directory for libraries that are built "in place".
-inplaceLibPath :: FilePath
-inplaceLibPath = "inplace/lib"
-
--- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
-inplaceLibBinPath :: FilePath
-inplaceLibBinPath = "inplace/lib/bin"
-
--- | Given a 'Package', return the path where the corresponding program is
--- installed. Most programs are installed in 'programInplacePath'.
-inplaceInstallPath :: Package -> FilePath
-inplaceInstallPath pkg
-    | pkg == touchy   = inplaceLibBinPath
-    | pkg == unlit    = inplaceLibBinPath
-    | pkg == iservBin = inplaceLibBinPath
-    | otherwise       = inplaceBinPath
-
--- ref: ghc/ghc.mk:142
--- ref: driver/ghc.mk
--- ref: utils/hsc2hs/ghc.mk:35
--- | Files that need to be copied over to inplace/lib
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
-    [ "ghc-usage.txt"
-    , "ghci-usage.txt"
-    , "platformConstants"
-    , "settings"
-    , "template-hsc.h" ]
-
--- | Path to hsc2hs template.
-templateHscPath :: FilePath
-templateHscPath = "inplace/lib/template-hsc.h"
-
--- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
--- generated in "Rules.Generators.GhcSplit".
-ghcSplitPath :: FilePath
-ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
-
--- ref: mk/config.mk
--- | Command line tool for stripping.
-stripCmdPath :: Action FilePath
-stripCmdPath = do
-    targetPlatform <- setting TargetPlatform
-    top <- topDirectory
-    case targetPlatform of
-        "x86_64-unknown-mingw32" ->
-             return (top -/- "inplace/mingw/bin/strip.exe")
-        "arm-unknown-linux" ->
-             return ":" -- HACK: from the make-based system, see the ref above
-        _ -> return "strip"
index eb59c20..d77d998 100644 (file)
@@ -3,7 +3,7 @@
 -- If you don't copy the file your changes will be tracked by git and you can
 -- accidentally commit them.
 module UserSettings (
-    buildRootPath, userFlavours, userKnownPackages, verboseCommands,
+    userBuildRoot, userFlavours, userKnownPackages, verboseCommands,
     buildProgressColour, successColour, defaultDestDir, defaultStage1Only
     ) where
 
@@ -15,9 +15,9 @@ import Expression
 
 -- See doc/user-settings.md for instructions.
 
--- | All build results are put into 'buildRootPath' directory.
-buildRootPath :: FilePath
-buildRootPath = "_build"
+-- | All build results are put into the 'buildRoot' directory.
+userBuildRoot :: BuildRoot
+userBuildRoot = BuildRoot "_build"
 
 -- | User defined build flavours. See 'defaultFlavour' as an example.
 userFlavours :: [Flavour]
index 3cb964a..0887646 100644 (file)
@@ -19,7 +19,6 @@ import GHC
 import Oracles.Setting
 import Oracles.PackageData
 import Settings
-import Settings.Path
 import Settings.Builders.Ar
 import Target
 import UserSettings
@@ -185,15 +184,16 @@ runBuilderWith options builder args = do
     quietly $ cmd options [path] args
 
 -- | Given a 'Context' this 'Action' looks up its package dependencies in
--- 'Settings.Paths.packageDependencies' and wraps the results in appropriate
--- contexts. The only subtlety here is that we never depend on packages built in
--- 'Stage2' or later, therefore the stage of the resulting dependencies is
--- bounded from above at 'Stage1'. To compute package dependencies we scan
--- package cabal files, see "Rules.Cabal".
+-- 'Base.packageDependencies' and wraps the results in appropriate contexts.
+-- The only subtlety here is that we never depend on packages built in 'Stage2'
+-- or later, therefore the stage of the resulting dependencies is bounded from
+-- above at 'Stage1'. To compute package dependencies we scan package cabal
+-- files, see "Rules.Cabal".
 contextDependencies :: Context -> Action [Context]
 contextDependencies Context {..} = do
     let pkgContext = \pkg -> Context (min stage Stage1) pkg way
-    deps <- lookupValuesOrError packageDependencies (pkgNameString package)
+    path <- buildRoot <&> (-/- packageDependencies)
+    deps <- lookupValuesOrError path (pkgNameString package)
     pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
     return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps