Use Cabal directly in place of ghc-cabal + make build root configurable (#531)
authorAlp Mestanogullari <alpmestan@gmail.com>
Fri, 30 Mar 2018 18:31:03 +0000 (20:31 +0200)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 30 Mar 2018 18:31:03 +0000 (19:31 +0100)
* Use Cabal directly in place of ghc-cabal; make build root configurable.

This commit implements two significant changes (that were not easy to
separate):

- Don't use ghc-cabal anymore for getting information about Haskell packages.
  We now instead directly use Cabal-the-library.

- Make the build root configurable. This effectively gets rid of the inplace
  logic and allows us to place _all_ build artefacts in some directory of
  our choice, by passing '--build-root <some path>' to hadrian.

The code for this was mostly taken from #445.

* fix documentation rules

* remove some leftover unrelated, commented-out code

* more documentation fixes, address some feedback

* cleanup

* more cleanup

* boot and configure explicitly in travis CI scripts

* update cabal/ghc versions in .travis.yml (8.0.x not supported anymore)

* temporarily disable dynamic ways in Settings.Default

* update appveyor script

* travis: when booting with 8.2.2, build a complete stage2 compiler

* Fix CI?

Try to fix the CI by adding the `debug` rts way back in.

* Update Quickest.hs

Replicate the make build systems build flavours.

* Update .travis.yml

- Run selftest, and build in separate instances.
- try with python2
- and unify mac to stage2

* Update .travis.yml

upgrade python on mac

* [travis] os x: test the freshly built ghc

* Get rid of two unused GhcCabalMode constructors

* fix ghc-split rule, get rid of Install/Wrappers rules

* address more feedback

* ConfiguredCabal -> PackageData, more comments, more feedback addressed

* make the complete stage 2 build the default

* use a dummy package instead of base in Rules.hs

* update CI scripts

* attempt at fixing hadrian's -c option

* .travis.yml: use -c everywhere again

* travis: back to explicit './boot && ./configure'

* update README.md and doc/user-settings.md to reflect configurable build root

* some more feedback

63 files changed:
.travis.yml
README.md
appveyor.yml
doc/user-settings.md
hadrian.cabal
src/Base.hs
src/Builder.hs
src/Builder.hs-boot [new file with mode: 0644]
src/CommandLine.hs
src/Context.hs
src/Context/Paths.hs [new file with mode: 0644]
src/Expression.hs
src/Expression/Type.hs
src/GHC.hs
src/GHC/Packages.hs [new file with mode: 0644]
src/Hadrian/Builder.hs
src/Hadrian/Haskell/Cabal.hs
src/Hadrian/Haskell/Cabal/PackageData.hs [new file with mode: 0644]
src/Hadrian/Haskell/Cabal/Parse.hs
src/Hadrian/Haskell/Cabal/Parse.hs-boot [new file with mode: 0644]
src/Hadrian/Haskell/Cabal/Type.hs
src/Hadrian/Oracles/TextFile.hs
src/Hadrian/Package.hs
src/Hadrian/Utilities.hs
src/Main.hs
src/Oracles/ModuleFiles.hs
src/Oracles/PackageData.hs [deleted file]
src/Rules.hs
src/Rules/Clean.hs
src/Rules/Compile.hs
src/Rules/Configure.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Rules/Generate.hs
src/Rules/Gmp.hs
src/Rules/Install.hs [deleted file]
src/Rules/Libffi.hs
src/Rules/Library.hs
src/Rules/PackageData.hs
src/Rules/Program.hs
src/Rules/Register.hs
src/Rules/SourceDist.hs
src/Rules/Test.hs
src/Rules/Wrappers.hs [deleted file]
src/Settings.hs [changed mode: 0644->0755]
src/Settings/Builders/Cc.hs
src/Settings/Builders/Common.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/RunTest.hs
src/Settings/Default.hs
src/Settings/Flavours/Quickest.hs
src/Settings/Packages.hs [new file with mode: 0644]
src/Settings/Packages/Haskeline.hs [deleted file]
src/Settings/Packages/Rts.hs
src/Settings/Warnings.hs
src/UserSettings.hs
src/Utilities.hs

index 63b3e31..2415903 100644 (file)
@@ -2,61 +2,91 @@ sudo: true
 matrix:
     include:
         - os: linux
 matrix:
     include:
         - os: linux
-          env: MODE="--flavour=quickest inplace/bin/ghc-stage1"
-          compiler: "GHC 8.0.2"
+          env: MODE="selftest"
+          compiler: "GHC 8.2.2"
           addons:
               apt:
                   packages:
           addons:
               apt:
                   packages:
-                      - ghc-8.0.2
+                      - ghc-8.2.2
                       - cabal-install-2.0
                       - zlib1g-dev
                   sources: hvr-ghc
 
           before_install:
                       - cabal-install-2.0
                       - zlib1g-dev
                   sources: hvr-ghc
 
           before_install:
-              - PATH="/opt/ghc/8.0.2/bin:$PATH"
+              - PATH="/opt/ghc/8.2.2/bin:$PATH"
               - PATH="/opt/cabal/2.0/bin:$PATH"
 
           script:
               - PATH="/opt/cabal/2.0/bin:$PATH"
 
           script:
+              # boot & configure ghc source tree
+              - ./boot && ./configure
               # Run internal Hadrian tests
               # Run internal Hadrian tests
-              - ./build.sh -c selftest
+              - hadrian/build.sh selftest
 
 
-              # Build GHC
-              - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=-
+        - os: linux
+          env: MODE="--flavour=quickest"
+          compiler: "GHC 8.2.2"
+          addons:
+              apt:
+                  packages:
+                      - ghc-8.2.2
+                      - cabal-install-2.0
+                      - zlib1g-dev
+                  sources: hvr-ghc
+
+          before_install:
+              - PATH="/opt/ghc/8.2.2/bin:$PATH"
+              - PATH="/opt/cabal/2.0/bin:$PATH"
+
+          script:
+              # boot & configure ghc source tree
+              - ./boot && ./configure
+
+              # Build GHC, letting hadrian boot & configure the ghc source tree
+              - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=-
 
         - os: linux
           env: MODE="--flavour=quickest --integer-simple"
 
         - os: linux
           env: MODE="--flavour=quickest --integer-simple"
-          compiler: "GHC 8.2.1"
+          compiler: "GHC 8.4.1"
           addons:
               apt:
                   packages:
           addons:
               apt:
                   packages:
-                      - ghc-8.2.1
-                      - cabal-install-1.22
+                      - ghc-8.4.1
+                      - cabal-install-2.2
                       - zlib1g-dev
                   sources: hvr-ghc
 
           before_install:
                       - zlib1g-dev
                   sources: hvr-ghc
 
           before_install:
-              - PATH="/opt/ghc/8.2.1/bin:$PATH"
-              - PATH="/opt/cabal/1.22/bin:$PATH"
+              - PATH="/opt/ghc/8.4.1/bin:$PATH"
+              - PATH="/opt/cabal/2.2/bin:$PATH"
 
           script:
 
           script:
-              # Build GHC
-              - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=-
+              # boot & configure ghc source tree
+              - ./boot && ./configure
+
+              # build GHC
+              - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=-
 
               # Test GHC binary
 
               # Test GHC binary
-              - cd ..
-              - inplace/bin/ghc-stage2 -e 1+2
+              - _build/stage1/bin/ghc -e 1+2
 
         - os: osx
           osx_image: xcode8
 
         - os: osx
           osx_image: xcode8
-          env: MODE="--flavour=quickest --integer-simple inplace/bin/ghc-stage1"
+          env: MODE="--flavour=quickest --integer-simple"
           before_install:
               - brew update
           before_install:
               - brew update
-              - brew install ghc cabal-install python3
+              - brew install ghc cabal-install
+              - brew upgrade python
 
           script:
 
           script:
+              # boot and configure ghc source tree
+              - ./boot && ./configure
+
               # Due to timeout limit of OS X build on Travis CI,
               # we will ignore selftest and build only stage1
               # Due to timeout limit of OS X build on Travis CI,
               # we will ignore selftest and build only stage1
-              - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=-
+              - hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=-
+
+              # Test GHC binary
+              - _build/stage1/bin/ghc -e 1+2
 
 install:
     # Add Cabal to PATH
 
 install:
     # Add Cabal to PATH
@@ -83,8 +113,7 @@ install:
     # to ./ghc/hadrian -- one way to do it is to move the .git directory
     # and perform a hard reset in order to regenerate Hadrian files
     - mv .git ghc/hadrian
     # to ./ghc/hadrian -- one way to do it is to move the .git directory
     # and perform a hard reset in order to regenerate Hadrian files
     - mv .git ghc/hadrian
-    - cd ghc/hadrian
-    - git reset --hard HEAD
+    - cd ghc/hadrian && git reset --hard HEAD && cd ..
 
 cache:
     directories:
 
 cache:
     directories:
index bdd8ed8..620d405 100644 (file)
--- a/README.md
+++ b/README.md
@@ -57,6 +57,14 @@ are placed into `_build` and `inplace` directories.
 In addition to standard Shake flags (try `--help`), the build system
 currently supports several others:
 
 In addition to standard Shake flags (try `--help`), the build system
 currently supports several others:
 
+* `--build-root=PATH` or `-oPATH`: specify the directory in which you want to store all
+the build artifacts. If none is specified by the user, hadrian will store everything
+under `_build/` at the top of ghc's source tree. Unlike GHC's make build system,
+hadrian doesn't have any "inplace" logic left anymore. This option is therefore
+useful for GHC developers who want to build GHC in different ways or at different
+commits, from the same directory, and have the build products sit in different,
+isolated folders.
+
 * `--configure` or `-c`: use this flag to run the `boot` and `configure` scripts
 automatically, so that you don't have to remember to run them manually as you normally
 do when using Make (typically only in the first build):
 * `--configure` or `-c`: use this flag to run the `boot` and `configure` scripts
 automatically, so that you don't have to remember to run them manually as you normally
 do when using Make (typically only in the first build):
@@ -119,17 +127,6 @@ are currently not supported.
 
 To build a GHC source distribution tarball, run `build sdist-ghc`.
 
 
 To build a GHC source distribution tarball, run `build sdist-ghc`.
 
-#### Installation
-
-To build and install GHC artifacts, run `build install`.
-
-By default, GHC will be installed to the specified _prefix_ path on your system,
-relative to the root of the file system. For example on UNIX, GHC will be installed
-to `/usr/local/bin`. By setting the command line flag `--install-destdir=[DESTDIR]`,
-you can install GHC to path `DESTDIR/<prefix>` instead. Make sure you use correct
-absolute path as `DESTDIR` on Windows, e.g. `C:/path`, which installs GHC
-into `C:/path/usr/local`.
-
 #### Testing
 
 * `build validate` runs GHC tests by simply executing `make fast` in `testsuite/tests`
 #### Testing
 
 * `build validate` runs GHC tests by simply executing `make fast` in `testsuite/tests`
index 32fc436..9c163f8 100644 (file)
@@ -30,12 +30,17 @@ install:
     - appveyor-retry stack exec -- pacman -S autoconf automake-wrapper make patch python tar --noconfirm
 
 build_script:
     - appveyor-retry stack exec -- pacman -S autoconf automake-wrapper make patch python tar --noconfirm
 
 build_script:
+    # Boot and configure ghc source tree
+    - cd ..
+    - python boot && configure --enable-tarballs-autodownload
+    - cd hadrian
+
     # Build Hadrian and run internal Hadrian tests
     # Build Hadrian and run internal Hadrian tests
-    - build -c selftest
+    - build selftest
 
     # Build GHC
 
     # Build GHC
-    - build -j -c --flavour=quickest --no-progress --progress-colour=never --profile=-
+    - build -j --flavour=quickest --no-progress --progress-colour=never --profile=-
 
     # Test GHC binary
     - cd ..
 
     # Test GHC binary
     - cd ..
-    - inplace\bin\ghc-stage2 -e 1+2
+    - _build/stage1/bin/ghc -e 1+2
index 05e4efc..947a7c3 100644 (file)
@@ -5,16 +5,6 @@ You can customise Hadrian by copying the file `hadrian/src/UserSettings.hs` to
 copy the file your changes will be tracked by `git` and you can accidentally commit
 them). Here we document currently supported settings.
 
 copy the file your changes will be tracked by `git` and you can accidentally commit
 them). Here we document currently supported settings.
 
-## Build directory
-
-Hadrian puts build results into `_build` directory by default, which is
-specified by `userBuildRoot`:
-```haskell
--- | All build results are put into the 'buildRoot' directory.
-userBuildRoot :: BuildRoot
-userBuildRoot = BuildRoot "_build"
-```
-
 ## Build flavour
 
 Build _flavour_ is a collection of build settings that fully define a GHC build
 ## Build flavour
 
 Build _flavour_ is a collection of build settings that fully define a GHC build
index 6248df3..486148f 100644 (file)
@@ -22,18 +22,21 @@ executable hadrian
                        , Builder
                        , CommandLine
                        , Context
                        , Builder
                        , CommandLine
                        , Context
+                       , Context.Paths
                        , Context.Type
                        , Environment
                        , Expression
                        , Expression.Type
                        , Flavour
                        , GHC
                        , Context.Type
                        , Environment
                        , Expression
                        , Expression.Type
                        , Flavour
                        , GHC
+                       , GHC.Packages
                        , Hadrian.Builder
                        , Hadrian.Builder.Ar
                        , Hadrian.Builder.Sphinx
                        , Hadrian.Builder.Tar
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
                        , Hadrian.Builder
                        , Hadrian.Builder.Ar
                        , Hadrian.Builder.Sphinx
                        , Hadrian.Builder.Tar
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
+                       , Hadrian.Haskell.Cabal.PackageData
                        , Hadrian.Haskell.Cabal.Parse
                        , Hadrian.Haskell.Cabal.Type
                        , Hadrian.Oracles.ArgsHash
                        , Hadrian.Haskell.Cabal.Parse
                        , Hadrian.Haskell.Cabal.Type
                        , Hadrian.Oracles.ArgsHash
@@ -47,7 +50,6 @@ executable hadrian
                        , Oracles.Flag
                        , Oracles.Setting
                        , Oracles.ModuleFiles
                        , Oracles.Flag
                        , Oracles.Setting
                        , Oracles.ModuleFiles
-                       , Oracles.PackageData
                        , Rules
                        , Rules.Clean
                        , Rules.Compile
                        , Rules
                        , Rules.Clean
                        , Rules.Compile
@@ -57,7 +59,6 @@ executable hadrian
                        , Rules.Documentation
                        , Rules.Generate
                        , Rules.Gmp
                        , Rules.Documentation
                        , Rules.Generate
                        , Rules.Gmp
-                       , Rules.Install
                        , Rules.Libffi
                        , Rules.Library
                        , Rules.Program
                        , Rules.Libffi
                        , Rules.Library
                        , Rules.Program
@@ -65,7 +66,6 @@ executable hadrian
                        , Rules.Selftest
                        , Rules.SourceDist
                        , Rules.Test
                        , Rules.Selftest
                        , Rules.SourceDist
                        , Rules.Test
-                       , Rules.Wrappers
                        , Settings
                        , Settings.Builders.Alex
                        , Settings.Builders.Common
                        , Settings
                        , Settings.Builders.Alex
                        , Settings.Builders.Common
@@ -91,19 +91,8 @@ executable hadrian
                        , Settings.Flavours.Quick
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
                        , Settings.Flavours.Quick
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
-                       , Settings.Packages.Base
-                       , Settings.Packages.Cabal
-                       , Settings.Packages.Compiler
-                       , Settings.Packages.Ghc
-                       , Settings.Packages.GhcCabal
-                       , Settings.Packages.Ghci
-                       , Settings.Packages.GhcPkg
-                       , Settings.Packages.GhcPrim
-                       , Settings.Packages.Haddock
-                       , Settings.Packages.Haskeline
-                       , Settings.Packages.IntegerGmp
+                       , Settings.Packages
                        , Settings.Packages.Rts
                        , Settings.Packages.Rts
-                       , Settings.Packages.RunGhc
                        , Settings.Warnings
                        , Stage
                        , Target
                        , Settings.Warnings
                        , Stage
                        , Target
index c3cb353..fea33a9 100644 (file)
@@ -18,12 +18,14 @@ module Base (
     module Stage,
     module Way,
 
     module Stage,
     module Way,
 
+    -- * Files
+    configH, ghcVersionH,
     -- * Paths
     -- * Paths
-    hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
-    generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
-    inplaceLibCopyTargets, haddockHtmlResourcesStamp, templateHscPath,
-    stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp,
-    ghcSplitPath
+    hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
+    generatedDir, generatedPath,
+    stageBinPath, stageLibPath,
+    templateHscPath, ghcDeps,
+    relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
     ) where
 
 import Control.Applicative
     ) where
 
 import Control.Applicative
@@ -65,71 +67,60 @@ sourcePath = hadrianPath -/- "src"
 configH :: FilePath
 configH = "mk/config.h"
 
 configH :: FilePath
 configH = "mk/config.h"
 
+ghcVersionH :: Action FilePath
+ghcVersionH = generatedPath <&> (-/- "ghcversion.h")
+
 -- | The directory in 'buildRoot' containing the Shake database and other
 -- auxiliary files generated by Hadrian.
 shakeFilesDir :: FilePath
 shakeFilesDir = "hadrian"
 
 -- | The directory in 'buildRoot' containing the Shake database and other
 -- auxiliary files generated by Hadrian.
 shakeFilesDir :: FilePath
 shakeFilesDir = "hadrian"
 
--- | 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 = inplaceLibPath -/- "bin"
-
 -- | 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 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"
+generatedPath :: Action FilePath
+generatedPath = buildRoot <&> (-/- generatedDir)
 
 
--- | Path to the inplace package database used in 'Stage1' and later.
-inplacePackageDbPath :: FilePath
-inplacePackageDbPath = inplaceLibPath -/- "package.conf.d"
+-- | Path to the package database for the given stage of GHC,
+--   relative to the build root.
+relativePackageDbPath :: Stage -> FilePath
+relativePackageDbPath stage = stageString stage -/- "lib" -/- "package.conf.d"
 
 
--- | Path to the package database used in a given 'Stage'.
+-- | Path to the package database used in a given 'Stage', including
+--   the build root.
 packageDbPath :: Stage -> Action FilePath
 packageDbPath :: Stage -> Action FilePath
-packageDbPath Stage0 = buildRoot <&> (-/- stage0PackageDbDir)
-packageDbPath _      = return inplacePackageDbPath
+packageDbPath stage = buildRoot <&> (-/- relativePackageDbPath stage)
 
 -- | We use a stamp file to track the existence of a package database.
 packageDbStamp :: FilePath
 packageDbStamp = ".stamp"
 
 
 -- | We use a stamp file to track the existence of a package database.
 packageDbStamp :: FilePath
 packageDbStamp = ".stamp"
 
--- ref: GHC_DEPENDENCIES in ghc/ghc.mk
--- ref: INSTALL_LIBS in driver/ghc.mk
--- TODO: Derive this from Builder.runtimeDependencies
--- | Files that need to be copied over to 'inplaceLibPath'.
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
-    [ "ghc-usage.txt"
-    , "ghci-usage.txt"
-    , "llvm-targets"
-    , "platformConstants"
-    , "settings"
-    , "template-hsc.h" ]
-
--- TODO: This is fragile and will break if @README.md@ is removed. We need to
--- improve the story of program runtime dependencies on directories.
--- See: https://github.com/snowleopard/hadrian/issues/492.
--- | Path to a file in Haddock's HTML resource library.
-haddockHtmlResourcesStamp :: FilePath
-haddockHtmlResourcesStamp = inplaceLibPath -/- "html/README.md"
+-- | @bin@ directory for the given 'Stage' (including the build root)
+stageBinPath :: Stage -> Action FilePath
+stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin")
+
+-- | @lib@ directory for the given 'Stage' (including the build root)
+stageLibPath :: Stage -> Action FilePath
+stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib")
+
+-- | Files the `ghc` binary depends on
+ghcDeps :: Stage -> Action [FilePath]
+ghcDeps stage = mapM (\f -> stageLibPath stage <&> (-/- f))
+      [ "ghc-usage.txt"
+      , "ghci-usage.txt"
+      , "llvm-targets"
+      , "platformConstants"
+      , "settings" ]
 
 -- ref: utils/hsc2hs/ghc.mk
 -- | Path to 'hsc2hs' template.
 
 -- ref: utils/hsc2hs/ghc.mk
 -- | Path to 'hsc2hs' template.
-templateHscPath :: FilePath
-templateHscPath = inplaceLibPath -/- "template-hsc.h"
+templateHscPath :: Stage -> Action FilePath
+templateHscPath stage = stageLibPath stage <&> (-/- "template-hsc.h")
 
 -- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag.
 
 -- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag.
--- It is generated in "Rules.Generate".
-ghcSplitPath :: FilePath
-ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
+-- It is generated in "Rules.Generate". This function returns the path relative
+-- to the build root under which we will copy @ghc-split@.
+ghcSplitPath :: Stage -> FilePath
+ghcSplitPath stage = stageString stage -/- "bin" -/- "ghc-split"
index 67e1634..8ce2aea 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE InstanceSigs #-}
 module Builder (
     -- * Data types
 {-# LANGUAGE InstanceSigs #-}
 module Builder (
     -- * Data types
-    ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
+    ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
     SphinxMode (..), TarMode (..), Builder (..),
 
     -- * Builder properties
     SphinxMode (..), TarMode (..), Builder (..),
 
     -- * Builder properties
@@ -53,8 +53,20 @@ instance Binary   GhcMode
 instance Hashable GhcMode
 instance NFData   GhcMode
 
 instance Hashable GhcMode
 instance NFData   GhcMode
 
+-- | GHC cabal mode. Can configure, copy and register packages.
+data GhcCabalMode = Conf | HsColour | Check | Sdist
+    deriving (Eq, Generic, Show)
+
+instance Binary   GhcCabalMode
+instance Hashable GhcCabalMode
+instance NFData   GhcCabalMode
+
 -- | GhcPkg can initialise a package database and register packages in it.
 -- | GhcPkg can initialise a package database and register packages in it.
-data GhcPkgMode = Init | Update deriving (Eq, Generic, Show)
+data GhcPkgMode = Init         -- initialize a new database.
+                | Update       -- update a package.
+                | Clone        -- clone a package from one pkg database into another. @Copy@ is already taken by GhcCabalMode.
+                | Dependencies -- compute package dependencies.
+                deriving (Eq, Generic, Show)
 
 instance Binary   GhcPkgMode
 instance Hashable GhcPkgMode
 
 instance Binary   GhcPkgMode
 instance Hashable GhcPkgMode
@@ -82,15 +94,15 @@ data Builder = Alex
              | GenApply
              | GenPrimopCode
              | Ghc GhcMode Stage
              | GenApply
              | GenPrimopCode
              | Ghc GhcMode Stage
-             | GhcCabal
+             | GhcCabal GhcCabalMode Stage
              | GhcPkg GhcPkgMode Stage
              | Haddock HaddockMode
              | Happy
              | Hpc
              | Hp2Ps
              | HsCpp
              | GhcPkg GhcPkgMode Stage
              | Haddock HaddockMode
              | Happy
              | Hpc
              | Hp2Ps
              | HsCpp
-             | Hsc2Hs
-             | Ld
+             | Hsc2Hs Stage
+             | Ld Stage
              | Make FilePath
              | Nm
              | Objdump
              | Make FilePath
              | Nm
              | Objdump
@@ -103,6 +115,28 @@ data Builder = Alex
              | Tar TarMode
              | Unlit
              | Xelatex
              | Tar TarMode
              | Unlit
              | Xelatex
+             | CabalFlags Stage
+               -- ^ A \"virtual\" builder (not backed by a program),
+               --   used a lot in Settings.Packages, that allows us to
+               --   toggle cabal flags of packages depending on some `Args`
+               --   predicates, and then collect all those when we are about to
+               --   configure the said packages, in Hadrian.Haskell.Cabal.Parse,
+               --   so that we end up passing the appropriate flags to the Cabal
+               --   library. For example:
+               --
+               --   > package rts
+               --   >   ? builder CabalFlags
+               --   >   ? any (wayUnit Profiling) rtsWays
+               --   >   ? arg "profiling"
+               --
+               --   (from Settings.Packages) specifies that if we're
+               --   processing the rts package with the `CabalFlag` builder,
+               --   and if we're building a profiling-enabled way of the rts,
+               --   then we pass the @profiling@ argument to the builder. This
+               --   argument is then collected by the code that performs the
+               --   package configuration, and @rts.cabal@ is processed as if
+               --   we were passing @-fprofiling@ to our build tool.
+
              deriving (Eq, Generic, Show)
 
 instance Binary   Builder
              deriving (Eq, Generic, Show)
 
 instance Binary   Builder
@@ -119,13 +153,13 @@ builderProvenance = \case
     GenPrimopCode    -> context Stage0 genprimopcode
     Ghc _ Stage0     -> Nothing
     Ghc _ stage      -> context (pred stage) ghc
     GenPrimopCode    -> context Stage0 genprimopcode
     Ghc _ Stage0     -> Nothing
     Ghc _ stage      -> context (pred stage) ghc
-    GhcCabal         -> context Stage0 ghcCabal
+    GhcCabal _ _     -> context Stage1 ghcCabal
     GhcPkg _ Stage0  -> Nothing
     GhcPkg _ _       -> context Stage0 ghcPkg
     GhcPkg _ Stage0  -> Nothing
     GhcPkg _ _       -> context Stage0 ghcPkg
-    Haddock _        -> context Stage2 haddock
+    Haddock _        -> context Stage1 haddock
     Hpc              -> context Stage1 hpcBin
     Hp2Ps            -> context Stage0 hp2ps
     Hpc              -> context Stage1 hpcBin
     Hp2Ps            -> context Stage0 hp2ps
-    Hsc2Hs           -> context Stage0 hsc2hs
+    Hsc2Hs _         -> context Stage0 hsc2hs
     Unlit            -> context Stage0 unlit
     _                -> Nothing
   where
     Unlit            -> context Stage0 unlit
     _                -> Nothing
   where
@@ -142,24 +176,38 @@ instance H.Builder Builder where
         Configure dir -> return [dir -/- "configure"]
 
         Ghc _ Stage0 -> return []
         Configure dir -> return [dir -/- "configure"]
 
         Ghc _ Stage0 -> return []
-        Ghc _ _ -> do
+        Ghc _ stage -> do
+            root <- buildRoot
             win <- windowsHost
             touchyPath <- programPath (vanillaContext Stage0 touchy)
             unlitPath  <- builderPath Unlit
             win <- windowsHost
             touchyPath <- programPath (vanillaContext Stage0 touchy)
             unlitPath  <- builderPath Unlit
-            return $ [ ghcSplitPath -- TODO: Make conditional on --split-objects
-                     , inplaceLibPath -/- "ghc-usage.txt"
-                     , inplaceLibPath -/- "ghci-usage.txt"
-                     , inplaceLibPath -/- "llvm-targets"
-                     , inplaceLibPath -/- "platformConstants"
-                     , inplaceLibPath -/- "settings"
+            ghcdeps <- ghcDeps stage
+            return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects
                      , unlitPath ]
                      , unlitPath ]
+                  ++ ghcdeps
                   ++ [ touchyPath | win ]
 
                   ++ [ touchyPath | win ]
 
-        Haddock _ -> return [haddockHtmlResourcesStamp]
-        Hsc2Hs    -> return [templateHscPath]
+        Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage
         Make dir  -> return [dir -/- "Makefile"]
         _         -> return []
 
         Make dir  -> return [dir -/- "Makefile"]
         _         -> return []
 
+    -- query the builder for some information.
+    -- contrast this with runBuilderWith, which returns @Action ()@
+    -- this returns the @stdout@ from running the builder.
+    -- For now this only implements asking @ghc-pkg@ about package
+    -- dependencies.
+    askBuilderWith :: Builder -> BuildInfo -> Action String
+    askBuilderWith builder BuildInfo {..} = case builder of
+        GhcPkg Dependencies _ -> do
+            let input  = fromSingleton msgIn buildInputs
+                msgIn  = "[askBuilder] Exactly one input file expected."
+            needBuilder builder
+            path <- H.builderPath builder
+            need [path]
+            Stdout stdout <- cmd [path] ["--no-user-package-db", "field", input, "depends"]
+            return stdout
+        _ -> error $ "Builder " ++ show builder ++ " can not be asked!"
+
     runBuilderWith :: Builder -> BuildInfo -> Action ()
     runBuilderWith builder BuildInfo {..} = do
         path <- builderPath builder
     runBuilderWith :: Builder -> BuildInfo -> Action ()
     runBuilderWith builder BuildInfo {..} = do
         path <- builderPath builder
@@ -208,6 +256,15 @@ instance H.Builder Builder where
                     unit $ cmd [Cwd output] [path]        buildArgs
                     unit $ cmd [Cwd output] [path]        buildArgs
 
                     unit $ cmd [Cwd output] [path]        buildArgs
                     unit $ cmd [Cwd output] [path]        buildArgs
 
+                GhcPkg Clone _ -> do
+                    Stdout pkgDesc <- cmd [path]
+                      [ "--expand-pkgroot"
+                      , "--no-user-package-db"
+                      , "describe"
+                      , input -- the package name
+                      ]
+                    cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"])
+
                 _  -> cmd echo [path] buildArgs
 
 -- TODO: Some builders are required only on certain platforms. For example,
                 _  -> cmd echo [path] buildArgs
 
 -- TODO: Some builders are required only on certain platforms. For example,
@@ -233,7 +290,7 @@ systemBuilderPath builder = case builder of
     GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
     Happy           -> fromKey "happy"
     HsCpp           -> fromKey "hs-cpp"
     GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
     Happy           -> fromKey "happy"
     HsCpp           -> fromKey "hs-cpp"
-    Ld              -> fromKey "ld"
+    Ld _            -> fromKey "ld"
     Make _          -> fromKey "make"
     Nm              -> fromKey "nm"
     Objdump         -> fromKey "objdump"
     Make _          -> fromKey "make"
     Nm              -> fromKey "nm"
     Objdump         -> fromKey "objdump"
diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot
new file mode 100644 (file)
index 0000000..e8eed47
--- /dev/null
@@ -0,0 +1,46 @@
+module Builder where
+
+import Stage
+import Hadrian.Builder.Ar
+import Hadrian.Builder.Sphinx
+import Hadrian.Builder.Tar
+
+data CcMode = CompileC | FindCDependencies
+data GhcMode =  CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
+data GhcCabalMode = Conf | HsColour | Check | Sdist
+data GhcPkgMode = Init | Update | Clone | Dependencies
+data HaddockMode = BuildPackage | BuildIndex
+
+data Builder = Alex
+             | Ar ArMode Stage
+             | DeriveConstants
+             | Cc CcMode Stage
+             | Configure FilePath
+             | GenApply
+             | GenPrimopCode
+             | Ghc GhcMode Stage
+             | GhcCabal GhcCabalMode Stage
+             | GhcPkg GhcPkgMode Stage
+             | Haddock HaddockMode
+             | Happy
+             | Hpc
+             | Hp2Ps
+             | HsCpp
+             | Hsc2Hs Stage
+             | Ld Stage
+             | Make FilePath
+             | Nm
+             | Objdump
+             | Patch
+             | Perl
+             | Python
+             | Ranlib
+             | RunTest
+             | Sphinx SphinxMode
+             | Tar TarMode
+             | Unlit
+             | Xelatex
+             | CabalFlags Stage
+
+instance Eq Builder
+instance Show Builder
index e747a52..a76b47c 100644 (file)
@@ -1,16 +1,17 @@
 module CommandLine (
     optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
     cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
 module CommandLine (
     optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
     cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
-    cmdInstallDestDir, TestArgs(..), defaultTestArgs
+    cmdInstallDestDir, lookupBuildRoot, TestArgs(..), defaultTestArgs
     ) where
 
 import Data.Either
 import qualified Data.HashMap.Strict as Map
 import Data.List.Extra
 import Development.Shake hiding (Normal)
     ) where
 
 import Data.Either
 import qualified Data.HashMap.Strict as Map
 import Data.List.Extra
 import Development.Shake hiding (Normal)
-import Hadrian.Utilities
+import Hadrian.Utilities hiding (buildRoot)
 import System.Console.GetOpt
 import System.Environment
 import System.Console.GetOpt
 import System.Environment
+import qualified UserSettings
 
 -- | All arguments that can be passed to Hadrian via the command line.
 data CommandLineArgs = CommandLineArgs
 
 -- | All arguments that can be passed to Hadrian via the command line.
 data CommandLineArgs = CommandLineArgs
@@ -22,6 +23,7 @@ data CommandLineArgs = CommandLineArgs
     , progressColour :: UseColour
     , progressInfo   :: ProgressInfo
     , splitObjects   :: Bool
     , progressColour :: UseColour
     , progressInfo   :: ProgressInfo
     , splitObjects   :: Bool
+    , buildRoot      :: BuildRoot
     , testArgs       :: TestArgs }
     deriving (Eq, Show)
 
     , testArgs       :: TestArgs }
     deriving (Eq, Show)
 
@@ -36,6 +38,7 @@ defaultCommandLineArgs = CommandLineArgs
     , progressColour = Auto
     , progressInfo   = Brief
     , splitObjects   = False
     , progressColour = Auto
     , progressInfo   = Brief
     , splitObjects   = False
+    , buildRoot      = BuildRoot "_build"
     , testArgs       = defaultTestArgs }
 
 -- | These arguments are used by the `test` target.
     , testArgs       = defaultTestArgs }
 
 -- | These arguments are used by the `test` target.
@@ -62,6 +65,15 @@ readConfigure = Right $ \flags -> flags { configure = True }
 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
 
 readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
 readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
 
+readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs)
+readBuildRoot ms =
+    maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms)
+  where
+    go :: String -> Maybe BuildRoot
+    go = Just . BuildRoot
+    set :: BuildRoot -> CommandLineArgs -> CommandLineArgs
+    set flag flags = flags { buildRoot = flag }
+
 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
 
 readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
 readFreeze1 = Right $ \flags -> flags { freeze1 = True }
 
@@ -124,6 +136,8 @@ optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
 optDescrs =
     [ Option ['c'] ["configure"] (NoArg readConfigure)
       "Run the boot and configure scripts (if you do not want to run them manually)."
 optDescrs =
     [ Option ['c'] ["configure"] (NoArg readConfigure)
       "Run the boot and configure scripts (if you do not want to run them manually)."
+    , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT")
+      "Where to store build artifacts. (Default _build)."
     , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
       "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
     , Option [] ["freeze1"] (NoArg readFreeze1)
     , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
       "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
     , Option [] ["freeze1"] (NoArg readFreeze1)
@@ -157,6 +171,7 @@ cmdLineArgsMap = do
     let args = foldl (flip id) defaultCommandLineArgs (rights opts)
     return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
            $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
     let args = foldl (flip id) defaultCommandLineArgs (rights opts)
     return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
            $ insertExtra (progressInfo   args) -- Accessed by Hadrian.Utilities
+           $ insertExtra (buildRoot      args) -- Accessed by Hadrian.Utilities
            $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
            $ insertExtra args Map.empty
 
            $ insertExtra (testArgs       args) -- Accessed by Settings.Builders.RunTest
            $ insertExtra args Map.empty
 
@@ -169,6 +184,9 @@ cmdConfigure = configure <$> cmdLineArgs
 cmdFlavour :: Action (Maybe String)
 cmdFlavour = flavour <$> cmdLineArgs
 
 cmdFlavour :: Action (Maybe String)
 cmdFlavour = flavour <$> cmdLineArgs
 
+lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot
+lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs
+
 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
 
 lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
 lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
 
index 6377d9b..225752d 100644 (file)
@@ -7,16 +7,18 @@ module Context (
     withHsPackage,
 
     -- * Paths
     withHsPackage,
 
     -- * Paths
-    contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile,
+    contextDir, buildPath, buildDir,
+    pkgInplaceConfig, pkgSetupConfigFile,
     pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile,
     pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile,
-    pkgConfFile, objectPath
+    pkgConfFile, objectPath, contextPath, getContextPath,
+    libDir, libPath
     ) where
 
     ) where
 
+import Base
+import Context.Paths
 import Context.Type
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal
 import Context.Type
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal
-
-import Base
 import Oracles.Setting
 
 -- | Most targets are built only one way, hence the notion of 'vanillaContext'.
 import Oracles.Setting
 
 -- | Most targets are built only one way, hence the notion of 'vanillaContext'.
@@ -46,52 +48,42 @@ getStagedSettingList f = getSettingList . f =<< getStage
 
 -- | Construct an expression that depends on the Cabal file of the current
 -- package and is empty in a non-Haskell context.
 
 -- | Construct an expression that depends on the Cabal file of the current
 -- package and is empty in a non-Haskell context.
-withHsPackage :: (Monoid a, Semigroup a) => (FilePath -> Expr Context b a) -> Expr Context b a
+withHsPackage :: (Monoid a, Semigroup a) => (Context -> Expr Context b a) -> Expr Context b a
 withHsPackage expr = do
     pkg <- getPackage
 withHsPackage expr = do
     pkg <- getPackage
+    ctx <- getContext
     case pkgCabalFile pkg of
     case pkgCabalFile pkg of
-        Just file -> expr file
-        Nothing   -> mempty
-
--- | The directory in 'buildRoot' containing build artefacts of a given 'Context'.
-contextDir :: Context -> FilePath
-contextDir Context {..} = stageString stage -/- pkgPath package
+        Just _  -> expr ctx
+        Nothing -> mempty
 
 
--- | Path to the directory containing build artefacts of a given 'Context'.
-buildPath :: Context -> Action FilePath
-buildPath context = buildRoot <&> (-/- contextDir context)
+pkgId :: Context -> Action FilePath
+pkgId ctx@Context {..} = case pkgCabalFile package of
+    Just _  -> pkgIdentifier ctx
+    Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts
 
 
--- | Get the build path of the current 'Context'.
-getBuildPath :: Expr Context b FilePath
-getBuildPath = expr . buildPath =<< getContext
+libDir :: Context -> FilePath
+libDir Context {..} = stageString stage -/- "lib"
 
 
-pkgId :: Package -> Action FilePath
-pkgId package = case pkgCabalFile package of
-    Just file -> pkgIdentifier file
-    Nothing   -> return (pkgName package) -- Non-Haskell packages, e.g. rts
+-- | Path to the directory containg the final artifact in a given 'Context'
+libPath :: Context -> Action FilePath
+libPath context = buildRoot <&> (-/- libDir context)
 
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context@Context {..} prefix suffix = do
     path <- buildPath context
 
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context@Context {..} prefix suffix = do
     path <- buildPath context
-    pid  <- pkgId package
+    pid  <- pkgId context
     return $ path -/- prefix ++ pid ++ suffix
 
 -- | Path to inplace package configuration file of a given 'Context'.
 pkgInplaceConfig :: Context -> Action FilePath
 pkgInplaceConfig context = do
     return $ path -/- prefix ++ pid ++ suffix
 
 -- | Path to inplace package configuration file of a given 'Context'.
 pkgInplaceConfig :: Context -> Action FilePath
 pkgInplaceConfig context = do
-    path <- buildPath context
+    path <- contextPath context
     return $ path -/- "inplace-pkg-config"
 
     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 to the @setup-config@ of a given 'Context'.
 pkgSetupConfigFile :: Context -> Action FilePath
 pkgSetupConfigFile context = do
-    path <- buildPath context
+    path <- contextPath context
     return $ path -/- "setup-config"
 
 -- | Path to the haddock file of a given 'Context', e.g.:
     return $ path -/- "setup-config"
 
 -- | Path to the haddock file of a given 'Context', e.g.:
@@ -123,12 +115,10 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o"
 
 -- | Path to the configuration file of a given 'Context'.
 pkgConfFile :: Context -> Action FilePath
 
 -- | Path to the configuration file of a given 'Context'.
 pkgConfFile :: Context -> Action FilePath
-pkgConfFile Context {..} = do
+pkgConfFile ctx@Context {..} = do
     root  <- buildRoot
     root  <- buildRoot
-    pid   <- pkgId package
-    let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
-              | otherwise       = inplacePackageDbPath
-    return $ dbDir -/- pid <.> "conf"
+    pid   <- pkgId ctx
+    return $ root -/- relativePackageDbPath stage -/- pid <.> "conf"
 
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
 -- to its object file. For example:
 
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
 -- to its object file. For example:
diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs
new file mode 100644 (file)
index 0000000..b023c4d
--- /dev/null
@@ -0,0 +1,39 @@
+module Context.Paths where
+
+import Base
+import Context.Type
+import Hadrian.Expression
+
+-- | The directory to the current stage
+stageDir :: Context -> FilePath
+stageDir Context {..} = stageString stage
+
+-- | The path to the current stage
+stagePath :: Context -> Action FilePath
+stagePath context = buildRoot <&> (-/- stageDir context)
+
+getStagePath :: Expr Context b FilePath
+getStagePath = expr . stagePath =<< getContext
+
+-- | The directory in 'buildRoot' containing build artifacts of a given 'Context'.
+contextDir :: Context -> FilePath
+contextDir Context {..} = stageString stage -/- pkgPath package
+
+-- | Path to the context directory, containing the "build folder"
+contextPath :: Context -> Action FilePath
+contextPath context = buildRoot <&> (-/- contextDir context)
+
+getContextPath :: Expr Context b FilePath
+getContextPath = expr . contextPath =<< getContext
+
+-- | The directory in 'buildRoot' containing the object artifacts.
+buildDir :: Context -> FilePath
+buildDir context = contextDir context -/- "build"
+
+-- | Path to the directory containing build artifacts of a given 'Context'.
+buildPath :: Context -> Action FilePath
+buildPath context = buildRoot <&> (-/- buildDir context)
+
+-- | Get the build path of the current 'Context'.
+getBuildPath :: Expr Context b FilePath
+getBuildPath = expr . buildPath =<< getContext
index dc095e1..3a26f43 100644 (file)
@@ -13,31 +13,29 @@ module Expression (
     interpret, interpretInContext,
 
     -- * Convenient accessors
     interpret, interpretInContext,
 
     -- * Convenient accessors
-    getBuildRoot, getContext, getPkgData, getPkgDataList, getOutputs, getInputs,
-    getInput, getOutput,
+    getBuildRoot, getContext, getOutputs, getInputs,
+    getInput, getOutput, getPackageData,
 
     -- * Re-exports
     module Base,
     module Builder,
     module Context,
 
     -- * Re-exports
     module Base,
     module Builder,
     module Context,
-    module GHC
     ) where
 
 import Base
     ) where
 
 import Base
-import Builder
+import {-# SOURCE #-} Builder
 import Context hiding (stage, package, way)
 import Expression.Type
 import Context hiding (stage, package, way)
 import Expression.Type
-import GHC
 import Hadrian.Expression hiding (Expr, Predicate, Args)
 import Hadrian.Expression hiding (Expr, Predicate, Args)
-import Oracles.PackageData
-
--- | Get a value from the @package-data.mk@ file of the current context.
-getPkgData :: (FilePath -> PackageData) -> Expr String
-getPkgData key = expr . pkgData . key =<< getBuildPath
-
--- | Get a list of values from the @package-data.mk@ file of the current context.
-getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
-getPkgDataList key = expr . pkgDataList . key =<< getBuildPath
+import Hadrian.Haskell.Cabal.PackageData (PackageData)
+import Hadrian.Oracles.TextFile (readPackageDataFile)
+
+-- | Get values from a configured cabal stage.
+getPackageData :: (PackageData -> a) -> Expr a
+getPackageData key = do
+  ctx   <- getContext
+  Just cabal <- expr (readPackageDataFile ctx)
+  return $ key cabal
 
 -- | Is the build currently in the provided stage?
 stage :: Stage -> Predicate
 
 -- | Is the build currently in the provided stage?
 stage :: Stage -> Predicate
index 258f78e..8c5ede8 100644 (file)
@@ -1,10 +1,11 @@
 module Expression.Type where
 
 module Expression.Type where
 
-import Builder
 import Context.Type
 import Context.Type
-import qualified Hadrian.Expression as H
 import Way.Type
 
 import Way.Type
 
+import {-# SOURCE #-} Builder
+import qualified Hadrian.Expression as H
+
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
 -- read parameters of the current build 'Target'.
 type Expr a = H.Expr Context Builder a
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
 -- read parameters of the current build 'Target'.
 type Expr a = H.Expr Context Builder a
index 2a87d68..b22f3bb 100644 (file)
@@ -5,7 +5,7 @@ module GHC (
     deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc,
     ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim, ghcTags,
     ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp,
     deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc,
     ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim, ghcTags,
     ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp,
-    integerSimple, iservBin, iservLib, libffi, mtl, parsec, parallel, pretty,
+    integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty,
     primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time,
     touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,
     defaultPackages,
     primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time,
     touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,
     defaultPackages,
@@ -18,114 +18,12 @@ module GHC (
     ) where
 
 import Base
     ) where
 
 import Base
-import CommandLine
 import Context
 import Context
+import Flavour
+import GHC.Packages
 import Oracles.Flag
 import Oracles.Setting
 import Oracles.Flag
 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,
--- package 'win32' is built only on Windows. 'defaultPackages' defines default
--- conditions for building each package. Users can add their own packages and
--- modify build default build conditions in "UserSettings".
-ghcPackages :: [Package]
-ghcPackages =
-    [ array, base, binary, bytestring, cabal, compareSizes, compiler, containers
-    , deepseq, deriveConstants, directory, filepath, genapply, genprimopcode
-    , ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim
-    , ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp
-    , integerSimple, iservBin, iservLib, libffi, mtl, parsec, parallel, pretty
-    , primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text
-    , time, touchy, transformers, unlit, unix, win32, xhtml ]
-
--- TODO: Optimise by switching to sets of packages.
-isGhcPackage :: Package -> Bool
-isGhcPackage = (`elem` ghcPackages)
-
--- | Package definitions, see 'Package'.
-array               = hsLib  "array"
-base                = hsLib  "base"
-binary              = hsLib  "binary"
-bytestring          = hsLib  "bytestring"
-cabal               = hsLib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
-compareSizes        = hsUtil "compareSizes"    `setPath` "utils/compare_sizes"
-compiler            = hsTop  "ghc"             `setPath` "compiler"
-containers          = hsLib  "containers"
-deepseq             = hsLib  "deepseq"
-deriveConstants     = hsUtil "deriveConstants"
-directory           = hsLib  "directory"
-filepath            = hsLib  "filepath"
-genapply            = hsUtil "genapply"
-genprimopcode       = hsUtil "genprimopcode"
-ghc                 = hsPrg  "ghc-bin"         `setPath` "ghc"
-ghcBoot             = hsLib  "ghc-boot"
-ghcBootTh           = hsLib  "ghc-boot-th"
-ghcCabal            = hsUtil "ghc-cabal"
-ghcCompact          = hsLib  "ghc-compact"
-ghci                = hsLib  "ghci"
-ghcPkg              = hsUtil "ghc-pkg"
-ghcPrim             = hsLib  "ghc-prim"
-ghcTags             = hsUtil "ghctags"
-ghcSplit            = hsUtil "ghc-split"
-haddock             = hsUtil "haddock"
-haskeline           = hsLib  "haskeline"
-hsc2hs              = hsUtil "hsc2hs"
-hp2ps               = cUtil  "hp2ps"
-hpc                 = hsLib  "hpc"
-hpcBin              = hsUtil "hpc-bin"         `setPath` "utils/hpc"
-integerGmp          = hsLib  "integer-gmp"
-integerSimple       = hsLib  "integer-simple"
--- iservBin         = hsUtil "iserv" -- FIXME: See #507
-iservBin            = hsPrg  "iserv-bin"       `setPath` "iserv"
-iservLib            = hsLib  "libiserv"
-libffi              = cTop   "libffi"
-mtl                 = hsLib  "mtl"
-parsec              = hsLib  "parsec"
-parallel            = hsLib  "parallel"
-pretty              = hsLib  "pretty"
-primitive           = hsLib  "primitive"
-process             = hsLib  "process"
-rts                 = cTop   "rts"
-runGhc              = hsUtil "runghc"
-stm                 = hsLib  "stm"
-templateHaskell     = hsLib  "template-haskell"
-terminfo            = hsLib  "terminfo"
-text                = hsLib  "text"
-time                = hsLib  "time"
-touchy              = cUtil  "touchy"
-transformers        = hsLib  "transformers"
-unlit               = cUtil  "unlit"
-unix                = hsLib  "unix"
-win32               = hsLib  "Win32"
-xhtml               = hsLib  "xhtml"
-
--- | Construct a Haskell library package, e.g. @array@.
-hsLib :: PackageName -> Package
-hsLib name = hsLibrary name ("libraries" -/- name)
-
--- | Construct a top-level Haskell library package, e.g. @compiler@.
-hsTop :: PackageName -> Package
-hsTop name = hsLibrary name name
-
--- | Construct a top-level C library package, e.g. @rts@.
-cTop :: PackageName -> Package
-cTop name = cLibrary name name
-
--- | Construct a top-level Haskell program package, e.g. @ghc@.
-hsPrg :: PackageName -> Package
-hsPrg name = hsProgram name name
-
--- | Construct a Haskell utility package, e.g. @haddock@.
-hsUtil :: PackageName -> Package
-hsUtil name = hsProgram name ("utils" -/- name)
-
--- | Construct a C utility package, e.g. @haddock@.
-cUtil :: PackageName -> Package
-cUtil name = cProgram name ("utils" -/- name)
-
--- | Amend a package path if it doesn't conform to a typical pattern.
-setPath :: Package -> FilePath -> Package
-setPath pkg path = pkg { pkgPath = path }
+import Settings (flavour)
 
 -- | Packages that are built by default. You can change this in "UserSettings".
 defaultPackages :: Stage -> Action [Package]
 
 -- | Packages that are built by default. You can change this in "UserSettings".
 defaultPackages :: Stage -> Action [Package]
@@ -137,7 +35,6 @@ defaultPackages Stage3 = return []
 stage0Packages :: Action [Package]
 stage0Packages = do
     win <- windowsHost
 stage0Packages :: Action [Package]
 stage0Packages = do
     win <- windowsHost
-    ios <- iosHost
     cross <- crossCompiling
     return $ [ binary
              , cabal
     cross <- crossCompiling
     return $ [ binary
              , cabal
@@ -149,7 +46,6 @@ stage0Packages = do
              , ghc
              , ghcBoot
              , ghcBootTh
              , ghc
              , ghcBoot
              , ghcBootTh
-             , ghcCabal
              , ghci
              , ghcPkg
              , ghcTags
              , ghci
              , ghcPkg
              , ghcTags
@@ -161,15 +57,16 @@ stage0Packages = do
              , templateHaskell
              , text
              , transformers
              , templateHaskell
              , text
              , transformers
-             , unlit ]
-          ++ [ terminfo | not win, not ios, not cross ]
-          ++ [ touchy   | win ]
+             , unlit                         ]
+          ++ [ terminfo | not win, not cross ]
+          ++ [ touchy   | win                ]
 
 stage1Packages :: Action [Package]
 stage1Packages = do
     win        <- windowsHost
 
 stage1Packages :: Action [Package]
 stage1Packages = do
     win        <- windowsHost
-    intSimple  <- cmdIntegerSimple
+    intLib     <- integerLibrary =<< flavour
     libraries0 <- filter isLibrary <$> stage0Packages
     libraries0 <- filter isLibrary <$> stage0Packages
+    cross      <- crossCompiling
     return $ libraries0 -- Build all Stage0 libraries in Stage1
           ++ [ array
              , base
     return $ libraries0 -- Build all Stage0 libraries in Stage1
           ++ [ array
              , base
@@ -179,24 +76,25 @@ stage1Packages = do
              , directory
              , filepath
              , ghc
              , directory
              , filepath
              , ghc
-             , ghcCabal
              , ghcCompact
              , ghcCompact
+             , ghcPkg
              , ghcPrim
              , haskeline
              , ghcPrim
              , haskeline
-             , hpcBin
              , hsc2hs
              , hsc2hs
-             , if intSimple then integerSimple else integerGmp
+             , intLib
              , pretty
              , process
              , rts
              , pretty
              , process
              , rts
-             , runGhc
              , stm
              , time
              , stm
              , time
-             , xhtml              ]
-          ++ [ iservBin | not win ]
-          -- ++ [ iservLib | not win ] -- FIXME: See #507
-          ++ [ unix     | not win ]
-          ++ [ win32    | win     ]
+             , unlit
+             , xhtml                         ]
+          ++ [ haddock  | not cross          ]
+          ++ [ runGhc   | not cross          ]
+          ++ [ hpcBin   | not cross          ]
+          ++ [ iservBin | not win, not cross ]
+          ++ [ unix     | not win            ]
+          ++ [ win32    | win                ]
 
 stage2Packages :: Action [Package]
 stage2Packages = return [haddock]
 
 stage2Packages :: Action [Package]
 stage2Packages = return [haddock]
@@ -205,13 +103,17 @@ stage2Packages = return [haddock]
 -- assuming that the corresponding package's type is 'Program'. For example, GHC
 -- built in 'Stage0' is called @ghc-stage1@. If the given package is a
 -- 'Library', the function simply returns its name.
 -- assuming that the corresponding package's type is 'Program'. For example, GHC
 -- built in 'Stage0' is called @ghc-stage1@. If the given package is a
 -- 'Library', the function simply returns its name.
-programName :: Context -> String
-programName Context {..}
-    | package == ghc      = "ghc-stage" ++ show (fromEnum stage + 1)
-    | package == hpcBin   = "hpc"
-    | package == runGhc   = "runhaskell"
-    | package == iservBin = "ghc-iserv"
-    | otherwise           = pkgName package
+programName :: Context -> Action String
+programName Context {..} = do
+    cross <- crossCompiling
+    targetPlatform <- setting TargetPlatformFull
+    let prefix = if cross then targetPlatform ++ "-" else ""
+      in return $ prefix ++ case package of
+                              p | p == ghc      -> "ghc"
+                                | p == hpcBin   -> "hpc"
+                                | p == runGhc   -> "runhaskell"
+                                | p == iservBin -> "ghc-iserv"
+                              _                 ->  pkgName package
 
 -- | The build stage whose results are used when installing a package, or
 -- @Nothing@ if the package is not installed, e.g. because it is a user package.
 
 -- | The build stage whose results are used when installing a package, or
 -- @Nothing@ if the package is not installed, e.g. because it is a user package.
@@ -223,34 +125,20 @@ installStage pkg
         stages <- filterM (fmap (pkg `elem`) . defaultPackages) [Stage0 ..]
         return $ if null stages then Nothing else Just (maximum stages)
 
         stages <- filterM (fmap (pkg `elem`) . defaultPackages) [Stage0 ..]
         return $ if null stages then Nothing else Just (maximum stages)
 
--- | Is the program corresponding to a given context built 'inplace', i.e. in
--- the @inplace/bin@ directory? For most programs, only their /latest/ build
--- stages are built 'inplace'. The only exception is the GHC itself, which is
--- built 'inplace' in all stages. The function returns @False@ for libraries and
--- all user packages.
-isBuiltInplace :: Context -> Action Bool
-isBuiltInplace Context {..}
-    | isLibrary package          = return False
-    | not (isGhcPackage package) = return False
-    | package == ghc             = return True
-    | otherwise                  = (Just stage ==) <$> installStage package
-
 -- | The 'FilePath' to a program executable in a given 'Context'.
 programPath :: Context -> Action FilePath
 programPath context@Context {..} = do
 -- | The 'FilePath' to a program executable in a given 'Context'.
 programPath :: Context -> Action FilePath
 programPath context@Context {..} = do
-    path    <- buildPath context
-    inplace <- isBuiltInplace context
-    let contextPath = if inplace then inplacePath else path
-    return $ contextPath -/- programName context <.> exe
-  where
-    inplacePath | package `elem` [touchy, unlit, iservBin] = inplaceLibBinPath
-                | otherwise                                = inplaceBinPath
+    path    <- stageBinPath stage
+    pgm     <- programName context
+    return $ path -/- pgm <.> exe
 
 -- | Some contexts are special: their packages do not have @.cabal@ metadata or
 -- we cannot run @ghc-cabal@ on them, e.g. because the latter hasn't been built
 -- yet (this is the case with the 'ghcCabal' package in 'Stage0').
 nonCabalContext :: Context -> Bool
 
 -- | Some contexts are special: their packages do not have @.cabal@ metadata or
 -- we cannot run @ghc-cabal@ on them, e.g. because the latter hasn't been built
 -- yet (this is the case with the 'ghcCabal' package in 'Stage0').
 nonCabalContext :: Context -> Bool
-nonCabalContext Context {..} = (package `elem` [hp2ps, rts, touchy, unlit])
+nonCabalContext Context {..} = (package `elem` [ hp2ps
+                                               , touchy
+                                               ])
     || package == ghcCabal && stage == Stage0
 
 -- | Some program packages should not be linked with Haskell main function.
     || package == ghcCabal && stage == Stage0
 
 -- | Some program packages should not be linked with Haskell main function.
@@ -266,7 +154,20 @@ autogenPath context@Context {..}
     | package == iservBin = autogen "build/iserv"
     | otherwise           = autogen $ "build" -/- pkgName package
   where
     | package == iservBin = autogen "build/iserv"
     | otherwise           = autogen $ "build" -/- pkgName package
   where
-    autogen dir = buildPath context <&> (-/- dir -/- "autogen")
+    autogen dir = contextPath context <&> (-/- dir -/- "autogen")
+
+-- 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"
 
 buildDll0 :: Context -> Action Bool
 buildDll0 Context {..} = do
 
 buildDll0 :: Context -> Action Bool
 buildDll0 Context {..} = do
diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs
new file mode 100644 (file)
index 0000000..68c93ec
--- /dev/null
@@ -0,0 +1,105 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module GHC.Packages where
+
+import Hadrian.Package
+import Hadrian.Utilities
+
+-- | 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,
+-- package 'win32' is built only on Windows. 'defaultPackages' defines default
+-- conditions for building each package. Users can add their own packages and
+-- modify build default build conditions in "UserSettings".
+ghcPackages :: [Package]
+ghcPackages =
+    [ array, base, binary, bytestring, cabal, compareSizes, compiler, containers
+    , deepseq, deriveConstants, directory, filepath, genapply, genprimopcode
+    , ghc, ghcBoot, ghcBootTh, ghcCompact, ghci, ghcPkg, ghcPrim
+    , ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp
+    , integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive
+    , process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy
+    , transformers, unlit, unix, win32, xhtml
+    ]
+
+-- TODO: Optimise by switching to sets of packages.
+isGhcPackage :: Package -> Bool
+isGhcPackage = (`elem` ghcPackages)
+
+-- | Package definitions, see 'Package'.
+array               = hsLib  "array"
+base                = hsLib  "base"
+binary              = hsLib  "binary"
+bytestring          = hsLib  "bytestring"
+cabal               = hsLib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
+compareSizes        = hsUtil "compareSizes"    `setPath` "utils/compare_sizes"
+compiler            = hsTop  "ghc"             `setPath` "compiler"
+containers          = hsLib  "containers"
+deepseq             = hsLib  "deepseq"
+deriveConstants     = hsUtil "deriveConstants"
+directory           = hsLib  "directory"
+filepath            = hsLib  "filepath"
+genapply            = hsUtil "genapply"
+genprimopcode       = hsUtil "genprimopcode"
+ghc                 = hsPrg  "ghc-bin"         `setPath` "ghc"
+ghcBoot             = hsLib  "ghc-boot"
+ghcBootTh           = hsLib  "ghc-boot-th"
+ghcCabal            = hsUtil "ghc-cabal"
+ghcCompact          = hsLib  "ghc-compact"
+ghci                = hsLib  "ghci"
+ghcPkg              = hsUtil "ghc-pkg"
+ghcPrim             = hsLib  "ghc-prim"
+ghcTags             = hsUtil "ghctags"
+ghcSplit            = hsUtil "ghc-split"
+haddock             = hsUtil "haddock"
+haskeline           = hsLib  "haskeline"
+hsc2hs              = hsUtil "hsc2hs"
+hp2ps               = hsUtil "hp2ps"
+hpc                 = hsLib  "hpc"
+hpcBin              = hsUtil "hpc-bin"         `setPath` "utils/hpc"
+integerGmp          = hsLib  "integer-gmp"
+integerSimple       = hsLib  "integer-simple"
+iservBin            = hsUtil "iserv-bin"           `setPath` "iserv"
+libffi              = cTop   "libffi"
+mtl                 = hsLib  "mtl"
+parsec              = hsLib  "parsec"
+parallel            = hsLib  "parallel"
+pretty              = hsLib  "pretty"
+primitive           = hsLib  "primitive"
+process             = hsLib  "process"
+rts                 = cTop   "rts"
+runGhc              = hsUtil "runghc"
+stm                 = hsLib  "stm"
+templateHaskell     = hsLib  "template-haskell"
+terminfo            = hsLib  "terminfo"
+text                = hsLib  "text"
+time                = hsLib  "time"
+touchy              = hsUtil "touchy"
+transformers        = hsLib  "transformers"
+unlit               = hsUtil "unlit"
+unix                = hsLib  "unix"
+win32               = hsLib  "Win32"
+xhtml               = hsLib  "xhtml"
+
+
+-- | Construct a Haskell library package, e.g. @array@.
+hsLib :: PackageName -> Package
+hsLib name = hsLibrary name ("libraries" -/- name)
+
+-- | Construct a top-level Haskell library package, e.g. @compiler@.
+hsTop :: PackageName -> Package
+hsTop name = hsLibrary name name
+
+-- | Construct a top-level C library package, e.g. @rts@.
+cTop :: PackageName -> Package
+cTop name = cLibrary name name
+
+-- | Construct a top-level Haskell program package, e.g. @ghc@.
+hsPrg :: PackageName -> Package
+hsPrg name = hsProgram name name
+
+-- | Construct a Haskell utility package, e.g. @haddock@.
+hsUtil :: PackageName -> Package
+hsUtil name = hsProgram name ("utils" -/- name)
+
+-- | Amend a package path if it doesn't conform to a typical pattern.
+setPath :: Package -> FilePath -> Package
+setPath pkg path = pkg { pkgPath = path }
index 38810c7..5d645ee 100644 (file)
@@ -14,7 +14,7 @@
 module Hadrian.Builder (
     Builder (..), BuildInfo (..), needBuilder, runBuilder,
     runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,
 module Hadrian.Builder (
     Builder (..), BuildInfo (..), needBuilder, runBuilder,
     runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,
-    getBuilderPath, builderEnvironment
+    getBuilderPath, builderEnvironment, askWithResources
     ) where
 
 import Data.List
     ) where
 
 import Data.List
@@ -42,6 +42,11 @@ class ShakeValue b => Builder b where
     -- | The path to a builder.
     builderPath :: b -> Action FilePath
 
     -- | The path to a builder.
     builderPath :: b -> Action FilePath
 
+    -- | Ask the builder for information.
+    -- E.g. ask @ghc-pkg@ for package dependencies
+    -- capture the @stdout@ result and return it.
+    askBuilderWith :: b -> BuildInfo -> Action String
+
     -- | Runtime dependencies of a builder. For example, on Windows GHC requires
     -- the utility @touchy.exe@ to be avilable on a specific path.
     runtimeDependencies :: b -> Action [FilePath]
     -- | Runtime dependencies of a builder. For example, on Windows GHC requires
     -- the utility @touchy.exe@ to be avilable on a specific path.
     runtimeDependencies :: b -> Action [FilePath]
@@ -89,28 +94,40 @@ build = buildWith [] []
 buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
 buildWithResources rs = buildWith rs []
 
 buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
 buildWithResources rs = buildWith rs []
 
+askWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action String
+askWithResources rs = askWith rs []
+
 -- | Like 'build' but passes given options to Shake's 'cmd'.
 buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
 buildWithCmdOptions = buildWith []
 
 -- | Like 'build' but passes given options to Shake's 'cmd'.
 buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
 buildWithCmdOptions = buildWith []
 
-buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
-buildWith rs opts target args = do
+doWith :: (Builder b, ShakeValue c)
+       => (b -> BuildInfo -> Action a)
+       -> (Target c b -> Action ())
+       -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a
+doWith f info rs opts target args = do
     needBuilder (builder target)
     argList <- interpret target args
     trackArgsHash target -- Rerun the rule if the hash of argList has changed.
     needBuilder (builder target)
     argList <- interpret target args
     trackArgsHash target -- Rerun the rule if the hash of argList has changed.
-    putInfo target
+    info target
     verbose <- interpret target verboseCommand
     let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
     verbose <- interpret target verboseCommand
     let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
-    quietlyUnlessVerbose $ runBuilderWith (builder target) $
+    quietlyUnlessVerbose $ f (builder target) $
         BuildInfo { buildArgs      = argList
                   , buildInputs    = inputs target
                   , buildOutputs   = outputs target
                   , buildOptions   = opts
                   , buildResources = rs }
 
         BuildInfo { buildArgs      = argList
                   , buildInputs    = inputs target
                   , buildOutputs   = outputs target
                   , buildOptions   = opts
                   , buildResources = rs }
 
+buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
+buildWith = doWith runBuilderWith runInfo
+
+askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action String
+askWith = doWith askBuilderWith askInfo
+
 -- | Print out information about the command being executed.
 -- | Print out information about the command being executed.
-putInfo :: Show b => Target c b -> Action ()
-putInfo t = putProgressInfo =<< renderAction
+runInfo :: Show b => Target c b -> Action ()
+runInfo t = putProgressInfo =<< renderAction
     ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
     (digest $ inputs  t)
     (digest $ outputs t)
     ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
     (digest $ inputs  t)
     (digest $ outputs t)
@@ -119,6 +136,15 @@ putInfo t = putProgressInfo =<< renderAction
     digest [x] = x
     digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
 
     digest [x] = x
     digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
 
+askInfo :: Show b => Target c b -> Action ()
+askInfo t = putProgressInfo =<< renderActionNoOutput
+    ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
+    (digest $ inputs  t)
+  where
+    digest [] = "none"
+    digest [x] = x
+    digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
+
 -- | Get the path to the current builder.
 getBuilderPath :: Builder b => b -> Expr c b FilePath
 getBuilderPath = expr . builderPath
 -- | Get the path to the current builder.
 getBuilderPath :: Builder b => b -> Expr c b FilePath
 getBuilderPath = expr . builderPath
index ab5f334..faba64f 100644 (file)
@@ -13,32 +13,35 @@ module Hadrian.Haskell.Cabal (
     pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
     ) where
 
     pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
     ) where
 
+import Data.Maybe
 import Development.Shake
 
 import Development.Shake
 
-import Hadrian.Haskell.Cabal.Parse
+import Context.Type
+import Hadrian.Haskell.Cabal.Type        as C
+import Hadrian.Haskell.Cabal.PackageData as PD
 import Hadrian.Package
 import Hadrian.Oracles.TextFile
 
 -- | Read a Cabal file and return the package version. The Cabal file is tracked.
 import Hadrian.Package
 import Hadrian.Oracles.TextFile
 
 -- | Read a Cabal file and return the package version. The Cabal file is tracked.
-pkgVersion :: FilePath -> Action String
-pkgVersion cabalFile = version <$> readCabalFile cabalFile
+pkgVersion :: Context -> Action (Maybe String)
+pkgVersion = fmap (fmap C.version) . readCabalFile
 
 -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@.
 -- The Cabal file is tracked.
 
 -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@.
 -- The Cabal file is tracked.
-pkgIdentifier :: FilePath -> Action String
-pkgIdentifier cabalFile = do
-    cabal <- readCabalFile cabalFile
-    return $ if null (version cabal)
-        then name cabal
-        else name cabal ++ "-" ++ version cabal
+pkgIdentifier :: Context -> Action String
+pkgIdentifier ctx = do
+    cabal <- fromMaybe (error "Cabal file could not be read") <$> readCabalFile ctx
+    return $ if null (C.version cabal)
+        then C.name cabal
+        else C.name cabal ++ "-" ++ C.version cabal
 
 -- | Read a Cabal file and return the sorted list of the package dependencies.
 -- The current version does not take care of Cabal conditionals and therefore
 -- returns a crude overapproximation of actual dependencies. The Cabal file is
 -- tracked.
 
 -- | Read a Cabal file and return the sorted list of the package dependencies.
 -- The current version does not take care of Cabal conditionals and therefore
 -- returns a crude overapproximation of actual dependencies. The Cabal file is
 -- tracked.
-pkgDependencies :: FilePath -> Action [PackageName]
-pkgDependencies cabalFile = dependencies <$> readCabalFile cabalFile
+pkgDependencies :: Context -> Action (Maybe [PackageName])
+pkgDependencies = fmap (fmap PD.dependencies) . readPackageDataFile
 
 -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
 
 -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
-pkgSynopsis :: FilePath -> Action String
-pkgSynopsis cabalFile = synopsis <$> readCabalFile cabalFile
+pkgSynopsis :: Context -> Action (Maybe String)
+pkgSynopsis = fmap (fmap C.synopsis) . readCabalFile
diff --git a/src/Hadrian/Haskell/Cabal/PackageData.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs
new file mode 100644 (file)
index 0000000..9bbebcf
--- /dev/null
@@ -0,0 +1,46 @@
+module Hadrian.Haskell.Cabal.PackageData where
+
+import Development.Shake.Classes
+import Hadrian.Package.Type
+import GHC.Generics
+
+data PackageData = PackageData
+    { dependencies :: [PackageName]
+    , name         :: PackageName
+    , version      :: String
+    -- * used to be pkg Data
+    , componentId  :: String
+    , modules      :: [String]
+    , otherModules :: [String]
+    , synopsis     :: String
+    , description  :: String
+    , srcDirs      :: [String]
+    , deps         :: [String]
+    , depIpIds     :: [String]
+    , depNames     :: [String]
+    , depCompIds   :: [String]
+    , includeDirs  :: [String]
+    , includes     :: [String]
+    , installIncludes :: [String]
+    , extraLibs    :: [String]
+    , extraLibDirs :: [String]
+    , asmSrcs      :: [String]
+    , cSrcs        :: [String]
+    , cmmSrcs      :: [String]
+    , dataFiles    :: [String]
+    , hcOpts       :: [String]
+    , asmOpts      :: [String]
+    , ccOpts       :: [String]
+    , cmmOpts      :: [String]
+    , cppOpts      :: [String]
+    , ldOpts       :: [String]
+    , depIncludeDirs :: [String]
+    , depCcOpts    :: [String]
+    , depLdOpts    :: [String]
+    , buildGhciLib :: Bool
+    } deriving (Eq, Read, Show, Typeable, Generic)
+
+instance Binary PackageData
+
+instance Hashable PackageData
+instance NFData PackageData
index bd7b6ab..e3c675b 100644 (file)
 --
 -- Extracting Haskell package metadata stored in Cabal files.
 -----------------------------------------------------------------------------
 --
 -- Extracting Haskell package metadata stored in Cabal files.
 -----------------------------------------------------------------------------
-module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where
+module Hadrian.Haskell.Cabal.Parse
+  ( PackageData (..), parseCabal, parsePackageData
+  , parseCabalPkgId
+  , configurePackage, copyPackage, registerPackage
+  ) where
 
 import Data.List.Extra
 import Development.Shake
 
 import Data.List.Extra
 import Development.Shake
+import qualified Distribution.ModuleName               as ModuleName
 import qualified Distribution.Package                   as C
 import qualified Distribution.PackageDescription        as C
 import qualified Distribution.Package                   as C
 import qualified Distribution.PackageDescription        as C
+import qualified Distribution.PackageDescription.Configuration as C
 import qualified Distribution.PackageDescription.Parsec as C
 import qualified Distribution.PackageDescription.Parsec as C
+import qualified Distribution.Simple.Compiler          as C (packageKeySupported, languageToFlags, extensionsToFlags, compilerInfo)
+import qualified Distribution.Simple.GHC               as GHC
+import qualified Distribution.Simple.Program.Db        as Db
+import qualified Distribution.Simple                   as Hooks (simpleUserHooks, autoconfUserHooks, defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor(GHC))
+import qualified Distribution.Simple.UserHooks         as Hooks
+import qualified Distribution.Simple.Program.Builtin   as C
+import qualified Distribution.Simple.Utils             as C (findHookedPackageDesc)
+import qualified Distribution.Simple.Program.Types     as C (programDefaultArgs, programOverrideArgs)
+import qualified Distribution.Simple.Configure         as C (getPersistBuildConfig)
+import qualified Distribution.Simple.Build             as C (initialBuildSteps)
+import qualified Distribution.Types.ComponentRequestedSpec as C (defaultComponentRequestedSpec)
+import qualified Distribution.InstalledPackageInfo as Installed
+import qualified Distribution.Simple.PackageIndex as PackageIndex
+import qualified Distribution.Types.LocalBuildInfo as C
 import qualified Distribution.Text                      as C
 import qualified Distribution.Types.CondTree            as C
 import qualified Distribution.Text                      as C
 import qualified Distribution.Types.CondTree            as C
+import qualified Distribution.Types.MungedPackageId    as C (mungedName)
 import qualified Distribution.Verbosity                 as C
 
 import qualified Distribution.Verbosity                 as C
 
-import Hadrian.Haskell.Cabal.Type
-
--- | Parse a Cabal file.
-parseCabal :: FilePath -> IO Cabal
-parseCabal file = do
-    gpd <- liftIO $ C.readGenericPackageDescription C.silent file
-    let pd      = C.packageDescription gpd
-        pkgId   = C.package pd
-        name    = C.unPackageName (C.pkgName pkgId)
-        version = C.display (C.pkgVersion pkgId)
-        libDeps = collectDeps (C.condLibrary gpd)
-        exeDeps = map (collectDeps . Just . snd) (C.condExecutables gpd)
-        allDeps = concat (libDeps : exeDeps)
-        sorted  = sort [ C.unPackageName p | C.Dependency p _ <- allDeps ]
-        deps    = nubOrd sorted \\ [name]
-    return $ Cabal deps name (C.synopsis pd) version
-
-collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]
-collectDeps Nothing = []
-collectDeps (Just (C.CondNode _ deps ifs)) = deps ++ concatMap f ifs
-  where
-    f (C.CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt
+import Base
+import Builder hiding (Builder)
+import Context
+import Flavour (args)
+import GHC.Packages (rts)
+import Hadrian.Expression
+import Hadrian.Haskell.Cabal.PackageData
+import Hadrian.Haskell.Cabal.Type ( Cabal( Cabal ) )
+import Hadrian.Oracles.TextFile
+import Hadrian.Target
+import Settings
+import Oracles.Setting
+
+-- | Parse the Cabal package identifier from the .cabal file at the given
+--   filepath.
+parseCabalPkgId :: FilePath -> IO String
+parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file
+
+
+biModules :: C.PackageDescription -> (C.BuildInfo, [ModuleName.ModuleName])
+biModules pd = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.library pd)
+                                         ++ (map exeBiModules $ C.executables pd)
+                        , C.buildable bi ]
+  where libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib)
+        exeBiModules exe = (C.buildInfo exe
+                           , if isHaskell (C.modulePath exe) -- if "main-is: ..." is not a .hs or .lhs file, do
+                                                             -- not inject "Main" into the modules.  This does
+                                                             -- not respect "-main-is" ghc-arguments!  See GHC.hs
+                                                             -- in Distribution.Simple.GHC from Cabal for the glory
+                                                             -- details.
+                             then ModuleName.main : C.exeModules exe
+                             else C.exeModules exe)
+        go [] = error "no buildable component found"
+        go [x] = x
+        go _  = error "can not handle more than one buildinfo yet!"
+        isHaskell fp = takeExtension fp `elem` [".hs", ".lhs"]
+
+-- | Parse the cabal file of the package from the given 'Context'.
+--
+--   This function reads the cabal file, gets some information about the compiler
+--   to be used corresponding to the stage it gets from the 'Context', and finalizes
+--   the package description it got from the cabal file with the additional information
+--   it got (e.g platform, compiler version conditionals, package flags).
+parseCabal :: Context -> Action Cabal
+parseCabal context@Context {..} = do
+    let (Just file) = pkgCabalFile package
+
+    -- read the package description from the cabal file
+    gpd <- liftIO $ C.readGenericPackageDescription C.verbose file
+
+    -- configure the package with the ghc compiler for this stage.
+    hcPath <- builderPath (Ghc CompileHs stage)
+    (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb
+
+
+    flagList <- interpret (target context (CabalFlags stage) [] []) =<< args <$> flavour
+    let flags = foldr addFlag mempty flagList
+          where addFlag :: String -> C.FlagAssignment -> C.FlagAssignment
+                addFlag ('-':name) = C.insertFlagAssignment (C.mkFlagName name) False
+                addFlag ('+':name) = C.insertFlagAssignment (C.mkFlagName name) True
+                addFlag name       = C.insertFlagAssignment (C.mkFlagName name) True
+
+    let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (C.compilerInfo compiler) [] gpd
+    -- depPkgs are all those packages that are needed. These should be found in
+    -- the known build packages.  Even if they are not build in this stage.
+    let depPkgs = map (findPackageByName' . C.unPackageName . C.depPkgName)
+                . flip C.enabledBuildDepends C.defaultComponentRequestedSpec $ pd
+          where findPackageByName' p = case findPackageByName p of
+                  Just p' -> p'
+                  Nothing -> error $ "Failed to find package: " ++ show p
+    return $ Cabal (C.unPackageName . C.pkgName . C.package $ pd)
+                   (C.display . C.pkgVersion . C.package $ pd)
+                   (C.synopsis pd)
+                   gpd
+                   pd
+                   depPkgs
+
+-- | This function runs the equivalent of @cabal configure@ using the Cabal library
+--   directly, collecting all the configuration options and flags to be passed to Cabal
+--   before invoking it.
+--
+--   It of course also 'need's package database entries for the dependencies of
+--   the package the 'Context' points to.
+configurePackage :: Context -> Action ()
+configurePackage context@Context {..} = do
+    Just (Cabal _ _ _ gpd _pd depPkgs) <- readCabalFile context
+
+    -- Stage packages are those we have in this stage.
+    stagePkgs <- stagePackages stage
+    -- we'll need those package in our package database.
+    need =<< sequence [ pkgConfFile (context { package = pkg }) | pkg <- depPkgs, pkg `elem` stagePkgs ]
+
+    -- figure out what hooks we need.
+    hooks <- case C.buildType (C.flattenPackageDescription gpd) of
+          C.Configure -> pure Hooks.autoconfUserHooks
+          -- time has a "Custom" Setup.hs, but it's actually Configure
+          -- plus a "./Setup test" hook. However, Cabal is also
+          -- "Custom", but doesn't have a configure script.
+          C.Custom ->
+              do configureExists <- doesFileExist (replaceFileName (unsafePkgCabalFile package) "configure")
+                 if configureExists
+                     then pure Hooks.autoconfUserHooks
+                     else pure Hooks.simpleUserHooks
+          -- not quite right, but good enough for us:
+          _ | package == rts ->
+              -- don't try to do post conf validation for rts.
+              -- this will simply not work, due to the ld-options,
+              -- and the Stg.h.
+              pure $ Hooks.simpleUserHooks { Hooks.postConf = \_ _ _ _ -> return () }
+            | otherwise -> pure Hooks.simpleUserHooks
+
+
+    case pkgCabalFile package of
+      Nothing -> error "No a cabal package!"
+      Just _ -> do
+        -- compute the flaglist
+        flagList <- interpret (target context (CabalFlags stage) [] []) =<< args <$> flavour
+        -- compute the cabal conf args
+        argList <- interpret (target context (GhcCabal Conf stage) [] []) =<< args <$> flavour
+        liftIO $ do
+          Hooks.defaultMainWithHooksNoReadArgs hooks gpd (argList ++ ["--flags=" ++ unwords flagList])
+
+-- | Copies a built package (that the 'Context' points to) into a package
+--   database (the one for the ghc corresponding to the stage the 'Context'
+--   points to).
+copyPackage :: Context -> Action ()
+copyPackage context@Context {..} = do
+  -- original invocation
+    Just (Cabal _ _ _ gpd _ _) <- readCabalFile context
+
+    top     <- topDirectory
+    ctxPath <- (top -/-) <$> Context.contextPath context
+    pkgDbPath <- (top -/-) <$> packageDbPath stage
+
+    let userHooks = Hooks.autoconfUserHooks
+        copyHooks = userHooks
+        hooks = copyHooks
+
+    liftIO $ Hooks.defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath]
+
+-- | Registers a built package (the one the 'Context' points to)
+--   into the package database.
+registerPackage :: Context -> Action ()
+registerPackage context@Context {..} = do
+    top     <- topDirectory
+    ctxPath <- (top -/-) <$> Context.contextPath context
+    Just (Cabal _ _ _ gpd _ _) <- readCabalFile context
+    let userHooks = Hooks.autoconfUserHooks
+        regHooks = userHooks
+
+    liftIO $
+      Hooks.defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath]
+
+-- | Parses the 'PackageData' for a package (the one in the 'Context').
+parsePackageData :: Context -> Action PackageData
+parsePackageData context@Context {..} = do
+    -- XXX: This is conceptually wrong!
+    --      We should use the gpd, and
+    --      the flagAssignment and compiler, hostPlatform, ... information
+    --      from the lbi.  And then compute the finaliz PD (flags, satisfiable dependencies, platform, compiler info, deps, gpd.)
+    -- 
+    -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd
+    --
+    -- However when using the new-build path's this might change.
+
+    Just (Cabal _ _ _ _gpd pd _depPkgs) <- readCabalFile context
+
+    cPath <- Context.contextPath context
+    need [cPath -/- "setup-config"]
+
+    lbi <- liftIO $ C.getPersistBuildConfig cPath
+
+    -- XXX: move this into it's own rule for build/autogen/cabal_macros.h, and build/autogen/Path_*.hs
+    --      and "need" them here.
+    -- create the cabal_macros.h, ...
+    -- Note: the `cPath` is ignored. The path that's used is the `buildDir` path from the local build info (lbi).
+    pdi <- liftIO $ getHookedBuildInfo (pkgPath package)
+    let pd' = C.updatePackageDescription pdi pd
+        lbi' = lbi { C.localPkgDescr = pd' }
+    liftIO $ C.initialBuildSteps cPath pd' lbi' C.silent
+
+    let extDeps = C.externalPackageDeps lbi'
+        deps    = map (C.display . snd) extDeps
+        dep_direct = map (fromMaybe (error "dep_keys failed")
+                          . PackageIndex.lookupUnitId (C.installedPkgs lbi')
+                          . fst) extDeps
+        dep_ipids = map (C.display . Installed.installedUnitId) dep_direct
+
+        Just ghcProg = Db.lookupProgram C.ghcProgram (C.withPrograms lbi')
+
+        dep_pkgs = PackageIndex.topologicalOrder (packageHacks (C.installedPkgs lbi'))
+        forDeps f = concatMap f dep_pkgs
+
+        -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
+        packageHacks = case Hooks.compilerFlavor (C.compiler lbi') of
+          Hooks.GHC | C.pkgName (C.package pd') /= (C.mkPackageName "rts") -> hackRtsPackage
+          _   -> id
+        -- We don't link in the actual Haskell libraries of our
+        -- dependencies, so the -u flags in the ldOptions of the rts
+        -- package mean linking fails on OS X (it's ld is a tad
+        -- stricter than gnu ld). Thus we remove the ldOptions for
+        -- GHC's rts package:
+        hackRtsPackage index | null (PackageIndex.allPackages index) = index
+        -- ^ do not hack the empty index
+        hackRtsPackage index =
+          case PackageIndex.lookupPackageName index (C.mkPackageName "rts") of
+            [(_,[rts])] ->
+              PackageIndex.insert rts{
+                Installed.ldOptions = [],
+                Installed.libraryDirs = filter (not . ("gcc-lib" `isSuffixOf`)) (Installed.libraryDirs rts)} index
+                    -- GHC <= 6.12 had $topdir/gcc-lib in their
+                    -- library-dirs for the rts package, which causes
+                    -- problems when we try to use the in-tree mingw,
+                    -- due to accidentally picking up the incompatible
+                    -- libraries there.  So we filter out gcc-lib from
+                    -- the RTS's library-dirs here.
+            _ -> error "No (or multiple) ghc rts package is registered!!"
+
+      in return $ PackageData
+      { dependencies = deps
+      , name     = C.unPackageName . C.pkgName . C.package $ pd'
+      , version  = C.display . C.pkgVersion . C.package $ pd'
+      , componentId = C.localCompatPackageKey lbi'
+      , modules  = map C.display . snd . biModules $ pd'
+      , otherModules = map C.display . C.otherModules . fst . biModules $ pd'
+      , synopsis = C.synopsis pd'
+      , description = C.description pd'
+      , srcDirs = C.hsSourceDirs . fst . biModules $ pd'
+      , deps = deps
+      , depIpIds = dep_ipids
+      , depNames = map (C.display . C.mungedName . snd) extDeps
+      , depCompIds = if C.packageKeySupported (C.compiler lbi')
+                     then dep_ipids
+                     else deps
+      , includeDirs = C.includeDirs . fst . biModules $ pd'
+      , includes    = C.includes . fst . biModules $ pd'
+      , installIncludes = C.installIncludes . fst . biModules $ pd'
+      , extraLibs = C.extraLibs . fst . biModules $ pd'
+      , extraLibDirs = C.extraLibDirs . fst . biModules $ pd'
+      , asmSrcs = C.asmSources . fst . biModules $ pd'
+      , cSrcs   = C.cSources . fst . biModules $ pd'
+      , cmmSrcs = C.cmmSources . fst . biModules $ pd'
+      , dataFiles = C.dataFiles pd'
+      , hcOpts    =    C.programDefaultArgs ghcProg
+                    ++ (C.hcOptions Hooks.GHC . fst . biModules $ pd')
+                    ++ C.languageToFlags (C.compiler lbi') (C.defaultLanguage . fst . biModules $ pd')
+                    ++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions . fst . biModules $ pd')
+                    ++ C.programOverrideArgs ghcProg
+      , asmOpts   = C.asmOptions . fst . biModules $ pd'
+      , ccOpts    = C.ccOptions . fst . biModules $ pd'
+      , cmmOpts   = C.cmmOptions . fst . biModules $ pd'
+      , cppOpts   = C.cppOptions . fst . biModules $ pd'
+      , ldOpts    = C.ldOptions . fst . biModules $ pd'
+      , depIncludeDirs = forDeps Installed.includeDirs
+      , depCcOpts = forDeps Installed.ccOptions
+      , depLdOpts = forDeps Installed.ldOptions
+      , buildGhciLib = C.withGHCiLib lbi'
+      }
+
+getHookedBuildInfo :: FilePath -> IO C.HookedBuildInfo
+getHookedBuildInfo baseDir = do
+  -- TODO: We should probably better generate this in the
+  --       build dir, rather then in the base dir? However
+  --       `configure` is run in the baseDir.
+
+  maybe_infoFile <- C.findHookedPackageDesc baseDir
+  case maybe_infoFile of
+    Nothing       -> return C.emptyHookedBuildInfo
+    Just infoFile -> C.readHookedBuildInfo C.silent infoFile
diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs-boot b/src/Hadrian/Haskell/Cabal/Parse.hs-boot
new file mode 100644 (file)
index 0000000..6517c8d
--- /dev/null
@@ -0,0 +1,9 @@
+module Hadrian.Haskell.Cabal.Parse where
+
+import Context.Type (Context)
+import Development.Shake (Action)
+import Hadrian.Haskell.Cabal.PackageData (PackageData)
+import Hadrian.Haskell.Cabal.Type (Cabal)
+
+parseCabal :: Context -> Action Cabal
+parsePackageData :: Context -> Action PackageData
index df3255f..1383051 100644 (file)
@@ -1,23 +1,23 @@
 module Hadrian.Haskell.Cabal.Type where
 
 import Development.Shake.Classes
 module Hadrian.Haskell.Cabal.Type where
 
 import Development.Shake.Classes
+import Distribution.PackageDescription (GenericPackageDescription, PackageDescription)
+import GHC.Generics
 import Hadrian.Package.Type
 
 import Hadrian.Package.Type
 
--- TODO: Use fine-grain tracking instead of tracking the whole Cabal file.
 -- | Haskell package metadata extracted from a Cabal file.
 data Cabal = Cabal
 -- | Haskell package metadata extracted from a Cabal file.
 data Cabal = Cabal
-    { dependencies :: [PackageName]
-    , name         :: PackageName
-    , synopsis     :: String
-    , version      :: String
-    } deriving (Eq, Read, Show, Typeable)
+    { name                      :: PackageName
+    , version                   :: String
+    , synopsis                  :: String
+    , genericPackageDescription :: GenericPackageDescription
+    , packageDescription        :: PackageDescription
+    , packageDependencies       :: [Package]
+    } deriving (Eq, Show, Typeable, Generic)
 
 
-instance Binary Cabal where
-    put = put . show
-    get = fmap read get
+instance Binary Cabal
 
 instance Hashable Cabal where
     hashWithSalt salt = hashWithSalt salt . show
 
 
 instance Hashable Cabal where
     hashWithSalt salt = hashWithSalt salt . show
 
-instance NFData Cabal where
-    rnf (Cabal a b c d) = a `seq` b `seq` c `seq` d `seq` ()
+instance NFData Cabal
index 6d4f048..400171e 100644 (file)
@@ -13,7 +13,7 @@
 module Hadrian.Oracles.TextFile (
     readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
     lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
 module Hadrian.Oracles.TextFile (
     readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
     lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
-    readCabalFile, textFileOracle
+    readCabalFile, readPackageDataFile, textFileOracle
     ) where
 
 import Control.Monad
     ) where
 
 import Control.Monad
@@ -23,16 +23,25 @@ import Development.Shake
 import Development.Shake.Classes
 import Development.Shake.Config
 
 import Development.Shake.Classes
 import Development.Shake.Config
 
-import Hadrian.Haskell.Cabal.Parse
+import Context.Type
+import Hadrian.Haskell.Cabal.PackageData
+import Hadrian.Haskell.Cabal.Type
+import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse
+import Hadrian.Package
 import Hadrian.Utilities
 import Hadrian.Utilities
+import Stage
 
 newtype TextFile = TextFile FilePath
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 type instance RuleResult TextFile = String
 
 
 newtype TextFile = TextFile FilePath
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 type instance RuleResult TextFile = String
 
-newtype CabalFile = CabalFile FilePath
+newtype CabalFile = CabalFile Context
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult CabalFile = Cabal
+type instance RuleResult CabalFile = Maybe Cabal
+
+newtype PackageDataFile = PackageDataFile Context
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult PackageDataFile = Maybe PackageData
 
 newtype KeyValue = KeyValue (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 newtype KeyValue = KeyValue (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
@@ -90,9 +99,12 @@ lookupDependencies depFile file = do
         Just (source : files) -> return (source, files)
 
 -- | Read and parse a @.cabal@ file, caching and tracking the result.
         Just (source : files) -> return (source, files)
 
 -- | Read and parse a @.cabal@ file, caching and tracking the result.
-readCabalFile :: FilePath -> Action Cabal
+readCabalFile :: Context -> Action (Maybe Cabal)
 readCabalFile = askOracle . CabalFile
 
 readCabalFile = askOracle . CabalFile
 
+readPackageDataFile :: Context -> Action (Maybe PackageData)
+readPackageDataFile = askOracle . PackageDataFile
+
 -- | This oracle reads and parses text files to answer 'readTextFile' and
 -- 'lookupValue' queries, as well as their derivatives, tracking the results.
 textFileOracle :: Rules ()
 -- | This oracle reads and parses text files to answer 'readTextFile' and
 -- 'lookupValue' queries, as well as their derivatives, tracking the results.
 textFileOracle :: Rules ()
@@ -116,8 +128,22 @@ textFileOracle = do
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
     void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
 
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
     void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
 
-    cabal <- newCache $ \file -> do
-        need [file]
-        putLoud $ "| CabalFile oracle: reading " ++ quote file ++ "..."
-        liftIO $ parseCabal file
-    void $ addOracle $ \(CabalFile file) -> cabal file
+    cabal <- newCache $ \(ctx@Context {..}) -> do
+        case pkgCabalFile package of
+          Just file -> do
+            need [file]
+            putLoud $ "| CabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
+            Just <$> parseCabal ctx
+          Nothing -> return Nothing
+
+    void $ addOracle $ \(CabalFile ctx) -> cabal ctx
+
+    confCabal <- newCache $ \(ctx@Context {..}) -> do
+        case pkgCabalFile package of
+          Just file -> do
+            need [file]
+            putLoud $ "| PackageDataFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
+            Just <$> parsePackageData ctx
+          Nothing -> return Nothing
+
+    void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx
index ffd5d38..698326b 100644 (file)
@@ -16,7 +16,7 @@ module Hadrian.Package (
     Package (..), PackageName, PackageLanguage, PackageType,
 
     -- * Construction and properties
     Package (..), PackageName, PackageLanguage, PackageType,
 
     -- * Construction and properties
-    cLibrary, cProgram, hsLibrary, hsProgram,
+    cLibrary, cProgram, hsLibrary, hsProgram, dummyPackage,
     isLibrary, isProgram, isCPackage, isHsPackage,
 
     -- * Package directory structure
     isLibrary, isProgram, isCPackage, isHsPackage,
 
     -- * Package directory structure
@@ -45,6 +45,13 @@ hsLibrary = Package Haskell Library
 hsProgram :: PackageName -> FilePath -> Package
 hsProgram = Package Haskell Program
 
 hsProgram :: PackageName -> FilePath -> Package
 hsProgram = Package Haskell Program
 
+-- | A dummy package, which we never try to build
+--   but just use as a better @undefined@ in code
+--   where we need a 'Package' to set up a Context
+--   but will not really operate over one.
+dummyPackage :: Package
+dummyPackage = hsLibrary "dummy" "dummy/path/"
+
 -- | Is this a library package?
 isLibrary :: Package -> Bool
 isLibrary (Package _ Library _ _) = True
 -- | Is this a library package?
 isLibrary :: Package -> Bool
 isLibrary (Package _ Library _ _) = True
@@ -63,6 +70,11 @@ isCPackage _ = False
 -- | Is this a Haskell package?
 isHsPackage :: Package -> Bool
 isHsPackage (Package Haskell _ _ _) = True
 -- | Is this a Haskell package?
 isHsPackage :: Package -> Bool
 isHsPackage (Package Haskell _ _ _) = True
+-- we consider the RTS as a haskell package because we
+-- use information from its Cabal file to build it,
+-- and we e.g want 'pkgCabalFile' to point us to
+-- 'rts/rts.cabal' when passed the rts package as argument.
+isHsPackage (Package _ _ "rts" _)   = True
 isHsPackage _ = False
 
 -- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@,
 isHsPackage _ = False
 
 -- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@,
index b775be2..4ef0970 100644 (file)
@@ -24,7 +24,7 @@ module Hadrian.Utilities (
     BuildProgressColour, mkBuildProgressColour, putBuild,
     SuccessColour, mkSuccessColour, putSuccess,
     ProgressInfo (..), putProgressInfo,
     BuildProgressColour, mkBuildProgressColour, putBuild,
     SuccessColour, mkSuccessColour, putSuccess,
     ProgressInfo (..), putProgressInfo,
-    renderAction, renderProgram, renderLibrary, renderBox, renderUnicorn,
+    renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn,
 
     -- * Miscellaneous
     (<&>), (%%>), cmdLineLengthLimit,
 
     -- * Miscellaneous
     (<&>), (%%>), cmdLineLengthLimit,
@@ -179,7 +179,7 @@ userSettingRules defaultValue = do
     extra <- shakeExtra <$> getShakeOptionsRules
     return $ lookupExtra defaultValue extra
 
     extra <- shakeExtra <$> getShakeOptionsRules
     return $ lookupExtra defaultValue extra
 
-newtype BuildRoot = BuildRoot FilePath deriving Typeable
+newtype BuildRoot = BuildRoot FilePath deriving (Typeable, Eq, Show)
 
 -- | All build results are put into the 'buildRoot' directory.
 buildRoot :: Action FilePath
 
 -- | All build results are put into the 'buildRoot' directory.
 buildRoot :: Action FilePath
@@ -388,6 +388,18 @@ renderAction what input output = do
     i = unifyPath input
     o = unifyPath output
 
     i = unifyPath input
     o = unifyPath output
 
+-- | Render an action.
+renderActionNoOutput :: String -> FilePath -> Action String
+renderActionNoOutput what input = do
+    progressInfo <- userSetting Brief
+    return $ case progressInfo of
+        None    -> ""
+        Brief   -> "| " ++ what ++ ": " ++ i
+        Normal  -> renderBox [ what, "     input: " ++ i ]
+        Unicorn -> renderUnicorn [ what, "     input: " ++ i ]
+  where
+    i = unifyPath input
+
 -- | Render the successful build of a program.
 renderProgram :: String -> String -> Maybe String -> String
 renderProgram name bin synopsis = renderBox $
 -- | Render the successful build of a program.
 renderProgram :: String -> String -> Maybe String -> String
 renderProgram name bin synopsis = renderBox $
index 52af0ad..c90b052 100644 (file)
@@ -10,7 +10,6 @@ import qualified Environment
 import qualified Rules
 import qualified Rules.Clean
 import qualified Rules.Documentation
 import qualified Rules
 import qualified Rules.Clean
 import qualified Rules.Documentation
-import qualified Rules.Install
 import qualified Rules.SourceDist
 import qualified Rules.Selftest
 import qualified Rules.Test
 import qualified Rules.SourceDist
 import qualified Rules.Selftest
 import qualified Rules.Test
@@ -23,10 +22,9 @@ main = do
     argsMap <- CommandLine.cmdLineArgsMap
     let extra = insertExtra UserSettings.buildProgressColour
               $ insertExtra UserSettings.successColour
     argsMap <- CommandLine.cmdLineArgsMap
     let extra = insertExtra UserSettings.buildProgressColour
               $ insertExtra UserSettings.successColour
-              $ insertExtra UserSettings.userBuildRoot
               $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap
 
               $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap
 
-        BuildRoot buildRoot = UserSettings.userBuildRoot
+        BuildRoot buildRoot = CommandLine.lookupBuildRoot argsMap
 
         rebuild = [ (RebuildLater, buildRoot -/- "stage0//*")
                   | CommandLine.lookupFreeze1 argsMap ]
 
         rebuild = [ (RebuildLater, buildRoot -/- "stage0//*")
                   | CommandLine.lookupFreeze1 argsMap ]
@@ -45,7 +43,6 @@ main = do
             Rules.buildRules
             Rules.Documentation.documentationRules
             Rules.Clean.cleanRules
             Rules.buildRules
             Rules.Documentation.documentationRules
             Rules.Clean.cleanRules
-            Rules.Install.installRules
             Rules.oracleRules
             Rules.Selftest.selftestRules
             Rules.SourceDist.sourceDistRules
             Rules.oracleRules
             Rules.Selftest.selftestRules
             Rules.SourceDist.sourceDistRules
index c7175db..fc3d72e 100644 (file)
@@ -8,8 +8,9 @@ import qualified Data.HashMap.Strict as Map
 import Base
 import Builder
 import Context
 import Base
 import Builder
 import Context
+import Expression
 import GHC
 import GHC
-import Oracles.PackageData
+import Hadrian.Haskell.Cabal.PackageData as PD
 
 newtype ModuleFiles = ModuleFiles (Stage, Package)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 newtype ModuleFiles = ModuleFiles (Stage, Package)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
@@ -26,19 +27,19 @@ haskellExtensions :: [String]
 haskellExtensions = [".hs", ".lhs"]
 
 -- | Non-Haskell source extensions and corresponding builders.
 haskellExtensions = [".hs", ".lhs"]
 
 -- | Non-Haskell source extensions and corresponding builders.
-otherExtensions :: [(String, Builder)]
-otherExtensions = [ (".x"  , Alex  )
-                  , (".y"  , Happy )
-                  , (".ly" , Happy )
-                  , (".hsc", Hsc2Hs) ]
+otherExtensions :: Stage -> [(String, Builder)]
+otherExtensions stage = [ (".x"  , Alex  )
+                        , (".y"  , Happy )
+                        , (".ly" , Happy )
+                        , (".hsc", Hsc2Hs stage) ]
 
 -- | We match the following file patterns when looking for module files.
 
 -- | We match the following file patterns when looking for module files.
-moduleFilePatterns :: [FilePattern]
-moduleFilePatterns = map ("*" ++) $ haskellExtensions ++ map fst otherExtensions
+moduleFilePatterns :: Stage -> [FilePattern]
+moduleFilePatterns stage = map ("*" ++) $ haskellExtensions ++ map fst (otherExtensions stage)
 
 -- | Given a FilePath determine the corresponding builder.
 
 -- | Given a FilePath determine the corresponding builder.
-determineBuilder :: FilePath -> Maybe Builder
-determineBuilder file = lookup (takeExtension file) otherExtensions
+determineBuilder :: Stage -> FilePath -> Maybe Builder
+determineBuilder stage file = lookup (takeExtension file) (otherExtensions stage)
 
 -- | Given a module name extract the directory and file name, e.g.:
 --
 
 -- | Given a module name extract the directory and file name, e.g.:
 --
@@ -71,7 +72,7 @@ findGenerator Context {..} file = do
     maybeSource <- askOracle $ Generator (stage, package, file)
     return $ do
         source  <- maybeSource
     maybeSource <- askOracle $ Generator (stage, package, file)
     return $ do
         source  <- maybeSource
-        builder <- determineBuilder source
+        builder <- determineBuilder stage source
         return (source, builder)
 
 -- | Find all Haskell source files for a given 'Context'.
         return (source, builder)
 
 -- | Find all Haskell source files for a given 'Context'.
@@ -88,10 +89,8 @@ hsSources context = do
 -- the build directory regardless of whether they are generated or not.
 hsObjects :: Context -> Action [FilePath]
 hsObjects context = do
 -- the build directory regardless of whether they are generated or not.
 hsObjects :: Context -> Action [FilePath]
 hsObjects context = do
-    path    <- buildPath context
-    modules <- pkgDataList (Modules path)
-    -- GHC.Prim module is only for documentation, we do not actually build it.
-    mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules)
+    modules <- interpretInContext context (getPackageData PD.modules)
+    mapM (objectPath context . moduleSource) modules
 
 -- | Generated module files live in the 'Context' specific build directory.
 generatedFile :: Context -> String -> Action FilePath
 
 -- | Generated module files live in the 'Context' specific build directory.
 generatedFile :: Context -> String -> Action FilePath
@@ -105,8 +104,8 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
 -- | Module files for a given 'Context'.
 contextFiles :: Context -> Action [(String, Maybe FilePath)]
 contextFiles context@Context {..} = do
 -- | Module files for a given 'Context'.
 contextFiles :: Context -> Action [(String, Maybe FilePath)]
 contextFiles context@Context {..} = do
-    path    <- buildPath context
-    modules <- fmap sort . pkgDataList $ Modules path
+    modules <- fmap sort . interpretInContext context $
+      getPackageData PD.modules
     zip modules <$> askOracle (ModuleFiles (stage, package))
 
 -- | This is an important oracle whose role is to find and cache module source
     zip modules <$> askOracle (ModuleFiles (stage, package))
 
 -- | This is an important oracle whose role is to find and cache module source
@@ -124,9 +123,8 @@ moduleFilesOracle :: Rules ()
 moduleFilesOracle = void $ do
     void . addOracle $ \(ModuleFiles (stage, package)) -> do
         let context = vanillaContext stage package
 moduleFilesOracle = void $ do
     void . addOracle $ \(ModuleFiles (stage, package)) -> do
         let context = vanillaContext stage package
-        path    <- buildPath context
-        srcDirs <-             pkgDataList $ SrcDirs path
-        modules <- fmap sort . pkgDataList $ Modules path
+        srcDirs <- interpretInContext context (getPackageData PD.srcDirs)
+        modules <- fmap sort $ interpretInContext context (getPackageData PD.modules)
         autogen <- autogenPath context
         let dirs = autogen : map (pkgPath package -/-) srcDirs
             modDirFiles = groupSort $ map decodeModule modules
         autogen <- autogenPath context
         let dirs = autogen : map (pkgPath package -/-) srcDirs
             modDirFiles = groupSort $ map decodeModule modules
@@ -134,7 +132,7 @@ moduleFilesOracle = void $ do
             todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
             forM todo $ \(mDir, mFiles) -> do
                 let fullDir = unifyPath $ dir -/- mDir
             todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
             forM todo $ \(mDir, mFiles) -> do
                 let fullDir = unifyPath $ dir -/- mDir
-                files <- getDirectoryFiles fullDir moduleFilePatterns
+                files <- getDirectoryFiles fullDir (moduleFilePatterns stage)
                 let cmp f = compare (dropExtension f)
                     found = intersectOrd cmp files mFiles
                 return (map (fullDir -/-) found, mDir)
                 let cmp f = compare (dropExtension f)
                     found = intersectOrd cmp files mFiles
                 return (map (fullDir -/-) found, mDir)
diff --git a/src/Oracles/PackageData.hs b/src/Oracles/PackageData.hs
deleted file mode 100644 (file)
index cdfe9bf..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-module Oracles.PackageData (
-    PackageData (..), PackageDataList (..), pkgData, pkgDataList
-    ) where
-
-import Hadrian.Oracles.TextFile
-
-import Base
-
-newtype PackageData = BuildGhciLib FilePath
-
-data PackageDataList = AsmSrcs        FilePath
-                     | CcArgs         FilePath
-                     | CSrcs          FilePath
-                     | CmmSrcs        FilePath
-                     | CppArgs        FilePath
-                     | DepCcArgs      FilePath
-                     | DepExtraLibs   FilePath
-                     | DepIds         FilePath
-                     | DepIncludeDirs FilePath
-                     | DepLdArgs      FilePath
-                     | DepLibDirs     FilePath
-                     | DepNames       FilePath
-                     | Deps           FilePath
-                     | HiddenModules  FilePath
-                     | HsArgs         FilePath
-                     | IncludeDirs    FilePath
-                     | LdArgs         FilePath
-                     | Modules        FilePath
-                     | SrcDirs        FilePath
-
-askPackageData :: FilePath -> String -> Action String
-askPackageData path = lookupValueOrEmpty (path -/- "package-data.mk")
-
--- | For each @PackageData path@ the file 'path/package-data.mk' contains a line
--- of the form 'path_VERSION = 1.2.3.4'. @pkgData (PackageData path)@ is an
--- Action that consults the file and returns "1.2.3.4".
-pkgData :: PackageData -> Action String
-pkgData packageData = case packageData of
-    BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
-
--- | @PackageDataList path@ is used for multiple string options separated by
--- spaces, such as @path_MODULES = Data.Array Data.Array.Base ...@.
--- @pkgListData Modules@ therefore returns ["Data.Array", "Data.Array.Base", ...]
-pkgDataList :: PackageDataList -> Action [String]
-pkgDataList packageData = fmap (map unquote . words) $ case packageData of
-    AsmSrcs        path -> askPackageData path "S_SRCS"
-    CcArgs         path -> askPackageData path "CC_OPTS"
-    CSrcs          path -> askPackageData path "C_SRCS"
-    CmmSrcs        path -> askPackageData path "CMM_SRCS"
-    CppArgs        path -> askPackageData path "CPP_OPTS"
-    DepCcArgs      path -> askPackageData path "DEP_CC_OPTS"
-    DepExtraLibs   path -> askPackageData path "DEP_EXTRA_LIBS"
-    DepIds         path -> askPackageData path "DEP_IPIDS"
-    DepIncludeDirs path -> askPackageData path "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
-    DepLibDirs     path -> askPackageData path "DEP_LIB_DIRS_SINGLE_QUOTED"
-    DepLdArgs      path -> askPackageData path "DEP_LD_OPTS"
-    DepNames       path -> askPackageData path "DEP_NAMES"
-    Deps           path -> askPackageData path "DEPS"
-    HiddenModules  path -> askPackageData path "HIDDEN_MODULES"
-    HsArgs         path -> askPackageData path "HC_OPTS"
-    IncludeDirs    path -> askPackageData path "INCLUDE_DIRS"
-    LdArgs         path -> askPackageData path "LD_OPTS"
-    Modules        path -> askPackageData path "MODULES"
-    SrcDirs        path -> askPackageData path "HS_SRC_DIRS"
-  where
-    unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
index d5c26e8..982d249 100644 (file)
@@ -6,6 +6,7 @@ import qualified Hadrian.Oracles.Path
 import qualified Hadrian.Oracles.TextFile
 
 import Expression
 import qualified Hadrian.Oracles.TextFile
 
 import Expression
+import GHC
 import qualified Oracles.ModuleFiles
 import qualified Rules.Compile
 import qualified Rules.PackageData
 import qualified Oracles.ModuleFiles
 import qualified Rules.Compile
 import qualified Rules.PackageData
@@ -20,33 +21,46 @@ import qualified Rules.Program
 import qualified Rules.Register
 import Settings
 import Target
 import qualified Rules.Register
 import Settings
 import Target
-import UserSettings
 import Utilities
 
 allStages :: [Stage]
 import Utilities
 
 allStages :: [Stage]
-allStages = [minBound ..]
+allStages = [minBound .. maxBound]
 
 -- | This rule calls 'need' on all top-level build targets, respecting the
 -- 'Stage1Only' flag.
 topLevelTargets :: Rules ()
 topLevelTargets = action $ do
 
 -- | This rule calls 'need' on all top-level build targets, respecting the
 -- 'Stage1Only' flag.
 topLevelTargets :: Rules ()
 topLevelTargets = action $ do
-    let libraryPackages = filter isLibrary (knownPackages \\ [libffi])
-    need =<< if stage1Only
-             then do
-                 libs <- concatForM [Stage0, Stage1] $ \stage ->
-                     concatForM libraryPackages $ packageTargets False stage
-                 prgs <- concatForM programsStage1Only $ packageTargets False Stage0
-                 return $ libs ++ prgs ++ inplaceLibCopyTargets
-             else do
-                 targets <- concatForM allStages $ \stage ->
-                     concatForM (knownPackages \\ [libffi]) $
-                        packageTargets False stage
-                 return $ targets ++ inplaceLibCopyTargets
+      (programs, libraries) <- partition isProgram <$> stagePackages Stage1
+      pgmNames <- mapM (g Stage1) programs
+      libNames <- mapM (g Stage1) libraries
+
+      verbosity <- getVerbosity
+      when (verbosity >= Loud) $ do
+        putNormal "Building stage2"
+        putNormal . unlines $
+          [ "| Building Programs:  " ++ intercalate ", " pgmNames
+          , "| Building Libraries: " ++ intercalate ", " libNames
+          ]
+
+      targets <- mapM (f Stage1) =<< stagePackages Stage1
+      need targets
+
+      where
+        -- either the package database config file for libraries or
+        -- the programPath for programs. However this still does
+        -- not support multiple targets, where a cabal package has
+        -- a library /and/ a program.
+        f :: Stage -> Package -> Action FilePath
+        f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v"))
+                    | otherwise     = programPath =<< programContext stage pkg
+        g :: Stage -> Package -> Action String
+        g stage pkg | isLibrary pkg = return $ pkgName pkg
+                    | otherwise     = programName (Context stage pkg (read "v"))
 
 -- TODO: Get rid of the @includeGhciLib@ hack.
 -- | Return the list of targets associated with a given 'Stage' and 'Package'.
 -- By setting the Boolean parameter to False it is possible to exclude the GHCi
 
 -- TODO: Get rid of the @includeGhciLib@ hack.
 -- | Return the list of targets associated with a given 'Stage' and 'Package'.
 -- By setting the Boolean parameter to False it is possible to exclude the GHCi
--- library from the targets, and avoid running @ghc-cabal@ to determine wether
+-- library from the targets, and avoid running @ghc-cabal@ to determine whether
 -- GHCi library needs to be built for this package. We typically want to set
 -- this parameter to True, however it is important to set it to False when
 -- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
 -- GHCi library needs to be built for this package. We typically want to set
 -- this parameter to True, however it is important to set it to False when
 -- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
@@ -90,16 +104,21 @@ packageRules = do
     let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
     forM_ dynamicContexts Rules.Library.buildDynamicLib
 
     let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
     forM_ dynamicContexts Rules.Library.buildDynamicLib
 
-    forM_ (filter isProgram knownPackages) $
-        Rules.Program.buildProgram readPackageDb
+    Rules.Program.buildProgram readPackageDb
+
+    forM_ [Stage0 .. ] $ \stage -> do
+      -- we create a dummy context, that has the correct state, but contains
+      -- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
+      -- need to be set properly. @undefined@ is not an option as it ends up
+      -- being forced.
+      Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla)
 
     forM_ vanillaContexts $ mconcat
         [ Rules.PackageData.buildPackageData
         , Rules.Dependencies.buildPackageDependencies readPackageDb
         , Rules.Documentation.buildPackageDocumentation
         , Rules.Library.buildPackageGhciLibrary
 
     forM_ vanillaContexts $ mconcat
         [ Rules.PackageData.buildPackageData
         , Rules.Dependencies.buildPackageDependencies readPackageDb
         , Rules.Documentation.buildPackageDocumentation
         , Rules.Library.buildPackageGhciLibrary
-        , Rules.Generate.generatePackageCode
-        , Rules.Register.registerPackage writePackageDb ]
+        , Rules.Generate.generatePackageCode ]
 
 buildRules :: Rules ()
 buildRules = do
 
 buildRules :: Rules ()
 buildRules = do
@@ -117,7 +136,3 @@ oracleRules = do
     Hadrian.Oracles.Path.pathOracle
     Hadrian.Oracles.TextFile.textFileOracle
     Oracles.ModuleFiles.moduleFilesOracle
     Hadrian.Oracles.Path.pathOracle
     Hadrian.Oracles.TextFile.textFileOracle
     Oracles.ModuleFiles.moduleFilesOracle
-
-programsStage1Only :: [Package]
-programsStage1Only = [ deriveConstants, genapply, genprimopcode, ghc, ghcCabal
-                     , ghcPkg, hp2ps, hpc, hsc2hs, runGhc ]
index 7592c60..1633ecd 100644 (file)
@@ -1,22 +1,19 @@
-module Rules.Clean (clean, cleanSourceTree, cleanRules) where
+module Rules.Clean (clean, cleanRules) where
 
 import Base
 
 clean :: Action ()
 clean = do
 
 import Base
 
 clean :: Action ()
 clean = do
+    putBuild "| Removing Hadrian files..."
     cleanSourceTree
     cleanSourceTree
-    putBuild "| Remove Hadrian files..."
     path <- buildRoot
     path <- buildRoot
-    removeDirectory $ path -/- generatedDir
-    removeFilesAfter path ["//*"]
+    removeDirectory path
     putSuccess "| Done. "
 
 cleanSourceTree :: Action ()
 cleanSourceTree = do
     path <- buildRoot
     forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString
     putSuccess "| Done. "
 
 cleanSourceTree :: Action ()
 cleanSourceTree = do
     path <- buildRoot
     forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString
-    removeDirectory inplaceBinPath
-    removeDirectory inplaceLibPath
     removeDirectory "sdistprep"
     cleanFsUtils
 
     removeDirectory "sdistprep"
     cleanFsUtils
 
@@ -31,6 +28,5 @@ cleanFsUtils = do
                ]
     liftIO $ forM_ dirs (flip removeFiles ["fs.*"])
 
                ]
     liftIO $ forM_ dirs (flip removeFiles ["fs.*"])
 
-
 cleanRules :: Rules ()
 cleanRules = "clean" ~> clean
 cleanRules :: Rules ()
 cleanRules = "clean" ~> clean
index 8bca888..4e85db2 100644 (file)
@@ -11,7 +11,8 @@ import Utilities
 
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context@Context {..} = do
 
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context@Context {..} = do
-    let dir             = "//" ++ contextDir context
+    root <- buildRootRules
+    let dir             = root -/- buildDir context
         nonHs extension = dir -/- extension <//> "*" <.> osuf way
         compile compiler obj2src obj = do
             src <- obj2src context obj
         nonHs extension = dir -/- extension <//> "*" <.> osuf way
         compile compiler obj2src obj = do
             src <- obj2src context obj
@@ -19,9 +20,10 @@ compilePackage rs context@Context {..} = do
             needDependencies context src $ obj <.> "d"
             buildWithResources rs $ target context (compiler stage) [src] [obj]
         compileHs = \[obj, _hi] -> do
             needDependencies context src $ obj <.> "d"
             buildWithResources rs $ target context (compiler stage) [src] [obj]
         compileHs = \[obj, _hi] -> do
-            path <- buildPath context
+            path <- contextPath context
             (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
             need $ src : deps
             (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
             need $ src : deps
+            needLibrary =<< contextDependencies context
             buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
 
     priority 2.0 $ do
             buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
 
     priority 2.0 $ do
index 9de31e2..13dbe9c 100644 (file)
@@ -12,7 +12,7 @@ import Utilities
 
 configureRules :: Rules ()
 configureRules = do
 
 configureRules :: Rules ()
 configureRules = do
-    [configFile, "settings", configH] &%> \outs -> do
+    [configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do
         skip <- not <$> cmdConfigure
         if skip
         then unlessM (doesFileExist configFile) $
         skip <- not <$> cmdConfigure
         if skip
         then unlessM (doesFileExist configFile) $
index f9d17e9..9589d12 100644 (file)
@@ -12,18 +12,20 @@ import Target
 import Utilities
 
 buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
 import Utilities
 
 buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
-buildPackageDependencies rs context@Context {..} =
-    "//" ++ contextDir context -/- ".dependencies" %> \deps -> do
+buildPackageDependencies rs context@Context {..} = do
+    root <- buildRootRules
+    root -/- contextDir context -/- ".dependencies.mk" %> \mk -> do
         srcs <- hsSources context
         need srcs
         orderOnly =<< interpretInContext context generatedDependencies
         srcs <- hsSources context
         need srcs
         orderOnly =<< interpretInContext context generatedDependencies
-        let mk = deps <.> "mk"
         if null srcs
         if null srcs
-        then writeFile' mk ""
+        then writeFileChanged mk ""
         else buildWithResources rs $
             target context (Ghc FindHsDependencies stage) srcs [mk]
         removeFile $ mk <.> "bak"
         else buildWithResources rs $
             target context (Ghc FindHsDependencies stage) srcs [mk]
         removeFile $ mk <.> "bak"
-        mkDeps <- liftIO $ readFile mk
+
+    root -/- contextDir context -/- ".dependencies" %> \deps -> do
+        mkDeps <- readFile' (deps <.> "mk")
         writeFileChanged deps . unlines
                               . map (\(src, deps) -> unwords $ src : deps)
                               . map (bimap unifyPath (map unifyPath))
         writeFileChanged deps . unlines
                               . map (\(src, deps) -> unwords $ src : deps)
                               . map (bimap unifyPath (map unifyPath))
index b8570a3..6523a2b 100644 (file)
@@ -8,35 +8,39 @@ module Rules.Documentation (
 
 import Base
 import Context
 
 import Base
 import Context
+import Expression (getPackageData, interpretInContext)
 import Flavour
 import GHC
 import Oracles.ModuleFiles
 import Flavour
 import GHC
 import Oracles.ModuleFiles
-import Oracles.PackageData
 import Settings
 import Target
 import Utilities
 
 import Settings
 import Target
 import Utilities
 
+import qualified Hadrian.Haskell.Cabal.PackageData as PD
+
 -- | Build all documentation
 documentationRules :: Rules ()
 documentationRules = do
 -- | Build all documentation
 documentationRules :: Rules ()
 documentationRules = do
+    root <- buildRootRules
     buildHtmlDocumentation
     buildPdfDocumentation
     buildDocumentationArchives
     buildManPage
     buildHtmlDocumentation
     buildPdfDocumentation
     buildDocumentationArchives
     buildManPage
-    "//docs//gen_contents_index" %> copyFile "libraries/gen_contents_index"
-    "//docs//prologue.txt" %> copyFile "libraries/prologue.txt"
+    root -/- htmlRoot -/- "libraries/gen_contents_index" %> copyFile "libraries/gen_contents_index"
+    root -/- htmlRoot -/- "libraries/prologue.txt" %> copyFile "libraries/prologue.txt"
     "docs" ~> do
         root <- buildRoot
         let html = htmlRoot -/- "index.html"
             archives = map pathArchive docPaths
             pdfs = map pathPdf $ docPaths \\ [ "libraries" ]
         need $ map (root -/-) $ [html] ++ archives ++ pdfs
     "docs" ~> do
         root <- buildRoot
         let html = htmlRoot -/- "index.html"
             archives = map pathArchive docPaths
             pdfs = map pathPdf $ docPaths \\ [ "libraries" ]
         need $ map (root -/-) $ [html] ++ archives ++ pdfs
-        need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ]
-        need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ]
-        need [manPagePath]
+        need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index"
+             , root -/- htmlRoot -/- "libraries" -/- "prologue.txt"
+             , root -/- manPageBuildPath
+             ]
 
 
-manPagePath :: FilePath
-manPagePath = "_build/docs/users_guide/build-man/ghc.1"
+manPageBuildPath :: FilePath
+manPageBuildPath = "docs/users_guide/build-man/ghc.1"
 
 -- TODO: Add support for Documentation Packages so we can
 -- run the builders without this hack.
 
 -- TODO: Add support for Documentation Packages so we can
 -- run the builders without this hack.
@@ -82,7 +86,8 @@ buildHtmlDocumentation :: Rules ()
 buildHtmlDocumentation = do
     mapM_ buildSphinxHtml $ docPaths \\ [ "libraries" ]
     buildLibraryDocumentation
 buildHtmlDocumentation = do
     mapM_ buildSphinxHtml $ docPaths \\ [ "libraries" ]
     buildLibraryDocumentation
-    "//" ++ htmlRoot -/- "index.html" %> \file -> do
+    root <- buildRootRules
+    root -/- htmlRoot -/- "index.html" %> \file -> do
         root <- buildRoot
         need $ map ((root -/-) . pathIndex) docPaths
         copyFileUntracked "docs/index.html" file
         root <- buildRoot
         need $ map ((root -/-) . pathIndex) docPaths
         copyFileUntracked "docs/index.html" file
@@ -93,9 +98,10 @@ buildHtmlDocumentation = do
 -- | Compile a Sphinx ReStructured Text package to HTML
 buildSphinxHtml :: FilePath -> Rules ()
 buildSphinxHtml path = do
 -- | Compile a Sphinx ReStructured Text package to HTML
 buildSphinxHtml :: FilePath -> Rules ()
 buildSphinxHtml path = do
-    "//" ++ htmlRoot -/- path -/- "index.html" %> \file -> do
+    root <- buildRootRules
+    root -/- htmlRoot -/- path -/- "index.html" %> \file -> do
         let dest = takeDirectory file
         let dest = takeDirectory file
-            context = vanillaContext Stage0 docPackage
+            context = vanillaContext Stage1 docPackage
         build $ target context (Sphinx Html) [pathPath path] [dest]
 
 -----------------------------
         build $ target context (Sphinx Html) [pathPath path] [dest]
 
 -----------------------------
@@ -104,11 +110,21 @@ buildSphinxHtml path = do
 -- | Build the haddocks for GHC's libraries
 buildLibraryDocumentation :: Rules ()
 buildLibraryDocumentation = do
 -- | Build the haddocks for GHC's libraries
 buildLibraryDocumentation :: Rules ()
 buildLibraryDocumentation = do
-    "//" ++ htmlRoot -/- "libraries/index.html" %> \file -> do
+    root <- buildRootRules
+
+    -- Js and Css files for haddock output
+    root -/- haddockHtmlLib %> \d -> do
+        let dir = takeDirectory d
+        liftIO $ removeFiles dir ["//*"]
+        copyDirectory "utils/haddock/haddock-api/resources/html" dir
+
+    root -/- htmlRoot -/- "libraries/index.html" %> \file -> do
         haddocks <- allHaddocks
         haddocks <- allHaddocks
-        need haddocks
-        let libDocs = filter (\x -> takeFileName x /= "ghc.haddock") haddocks
-            context = vanillaContext Stage2 docPackage
+        let libDocs = filter
+                (\x -> takeFileName x `notElem` ["ghc.haddock", "rts.haddock"])
+                haddocks
+            context = vanillaContext Stage1 docPackage
+        need (root -/- haddockHtmlLib : libDocs)
         build $ target context (Haddock BuildIndex) libDocs [file]
 
 allHaddocks :: Action [FilePath]
         build $ target context (Haddock BuildIndex) libDocs [file]
 
 allHaddocks :: Action [FilePath]
@@ -117,11 +133,13 @@ allHaddocks = do
     sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
              | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
 
     sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
              | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
 
+haddockHtmlLib ::FilePath
+haddockHtmlLib = "docs/html/haddock-bundle.min.js"
+
 -- | Find the haddock files for the dependencies of the current library
 haddockDependencies :: Context -> Action [FilePath]
 haddockDependencies context = do
 -- | Find the haddock files for the dependencies of the current library
 haddockDependencies :: Context -> Action [FilePath]
 haddockDependencies context = do
-    path     <- buildPath context
-    depNames <- pkgDataList $ DepNames path
+    depNames <- interpretInContext context (getPackageData PD.depNames)
     sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
              | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]
 
     sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
              | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]
 
@@ -129,26 +147,31 @@ haddockDependencies context = do
 -- All of them go into the 'doc' subdirectory. Pedantically tracking all built
 -- files in the Shake database seems fragile and unnecessary.
 buildPackageDocumentation :: Context -> Rules ()
 -- 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 {..} = when (stage == Stage1) $ do
-
-    -- Js and Css files for haddock output
-    when (package == haddock) $ haddockHtmlResourcesStamp %> \_ -> do
-        let dir = takeDirectory haddockHtmlResourcesStamp
-        liftIO $ removeFiles dir ["//*"]
-        copyDirectory "utils/haddock/haddock-api/resources/html" dir
+buildPackageDocumentation context@Context {..} = when (stage == Stage1 && package /= rts) $ do
+    root <- buildRootRules
 
     -- Per-package haddocks
 
     -- Per-package haddocks
-    "//" ++ pkgName package <.> "haddock" %> \file -> do
-        haddocks <- haddockDependencies context
-        srcs <- hsSources context
-        need $ srcs ++ haddocks
-
-        -- 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 BuildPackage)
-                       srcs [file]
+    root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do
+      -- this is how ghc-cabal produces "haddock-prologue.txt" files
+      (syn, desc) <- interpretInContext context . getPackageData $ \p ->
+        (PD.synopsis p, PD.description p)
+      let prologue = if null desc
+                     then syn
+                     else desc
+      liftIO (writeFile file prologue)
+
+    root -/- htmlRoot -/- "libraries" -/- pkgName package -/- pkgName package <.> "haddock" %> \file -> do
+      need [ root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" ]
+      haddocks <- haddockDependencies context
+      srcs <- hsSources context
+      need $ srcs ++ haddocks ++ [root -/- 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 BuildPackage)
+                     srcs [file]
 
 ----------------------------------------------------------------------
 -- PDF
 
 ----------------------------------------------------------------------
 -- PDF
@@ -160,8 +183,9 @@ buildPdfDocumentation = mapM_ buildSphinxPdf docPaths
 -- | Compile a Sphinx ReStructured Text package to LaTeX
 buildSphinxPdf :: FilePath -> Rules ()
 buildSphinxPdf path = do
 -- | Compile a Sphinx ReStructured Text package to LaTeX
 buildSphinxPdf :: FilePath -> Rules ()
 buildSphinxPdf path = do
-    "//" ++ path <.> "pdf" %> \file -> do
-        let context = vanillaContext Stage0 docPackage
+    root <- buildRootRules
+    root -/- pdfRoot -/- path <.> "pdf" %> \file -> do
+        let context = vanillaContext Stage1 docPackage
         withTempDir $ \dir -> do
             build $ target context (Sphinx Latex) [pathPath path] [dir]
             build $ target context Xelatex [path <.> "tex"] [dir]
         withTempDir $ \dir -> do
             build $ target context (Sphinx Latex) [pathPath path] [dir]
             build $ target context Xelatex [path <.> "tex"] [dir]
@@ -176,9 +200,10 @@ buildDocumentationArchives = mapM_ buildArchive docPaths
 
 buildArchive :: FilePath -> Rules ()
 buildArchive path = do
 
 buildArchive :: FilePath -> Rules ()
 buildArchive path = do
-    "//" ++ pathArchive path %> \file -> do
+    root <- buildRootRules
+    root -/- pathArchive path %> \file -> do
         root <- buildRoot
         root <- buildRoot
-        let context = vanillaContext Stage0 docPackage
+        let context = vanillaContext Stage1 docPackage
             src = root -/- pathIndex path
         need [src]
         build $ target context (Tar Create) [takeDirectory src] [file]
             src = root -/- pathIndex path
         need [src]
         build $ target context (Tar Create) [takeDirectory src] [file]
@@ -186,9 +211,10 @@ buildArchive path = do
 -- | build man page
 buildManPage :: Rules ()
 buildManPage = do
 -- | build man page
 buildManPage :: Rules ()
 buildManPage = do
-    manPagePath %> \file -> do
+    root <- buildRootRules
+    root -/- manPageBuildPath %> \file -> do
         need ["docs/users_guide/ghc.rst"]
         need ["docs/users_guide/ghc.rst"]
-        let context = vanillaContext Stage0 docPackage
+        let context = vanillaContext Stage1 docPackage
         withTempDir $ \dir -> do
             build $ target context (Sphinx Man) ["docs/users_guide"] [dir]
             copyFileUntracked (dir -/- "ghc.1") file
         withTempDir $ \dir -> do
             build $ target context (Sphinx Man) ["docs/users_guide"] [dir]
             copyFileUntracked (dir -/- "ghc.1") file
index a8f3956..2bae8d2 100644 (file)
@@ -6,14 +6,15 @@ module Rules.Generate (
 import Base
 import Expression
 import Flavour
 import Base
 import Expression
 import Flavour
+import GHC.Packages
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Rules.Gmp
 import Rules.Libffi
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Rules.Gmp
 import Rules.Libffi
-import Target
 import Settings
 import Settings.Packages.Rts
 import Settings
 import Settings.Packages.Rts
+import Target
 import Utilities
 
 -- | Track this file to rebuild generated files whenever it changes.
 import Utilities
 
 -- | Track this file to rebuild generated files whenever it changes.
@@ -24,10 +25,10 @@ primopsSource :: FilePath
 primopsSource = "compiler/prelude/primops.txt.pp"
 
 primopsTxt :: Stage -> FilePath
 primopsSource = "compiler/prelude/primops.txt.pp"
 
 primopsTxt :: Stage -> FilePath
-primopsTxt stage = contextDir (vanillaContext stage compiler) -/- "primops.txt"
+primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt"
 
 platformH :: Stage -> FilePath
 
 platformH :: Stage -> FilePath
-platformH stage = contextDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
+platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
 
 isGeneratedCmmFile :: FilePath -> Bool
 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
 
 isGeneratedCmmFile :: FilePath -> Bool
 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
@@ -99,59 +100,74 @@ generate file context expr = do
     putSuccess $ "| Successfully generated " ++ file ++ "."
 
 generatePackageCode :: Context -> Rules ()
     putSuccess $ "| Successfully generated " ++ file ++ "."
 
 generatePackageCode :: Context -> Rules ()
-generatePackageCode context@(Context stage pkg _) =
-    let dir         = contextDir context
-        generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
+generatePackageCode context@(Context stage pkg _) = do
+    root <- buildRootRules
+    let dir         = buildDir context
+        generated f = (root -/- dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
         go gen file = generate file context gen
         go gen file = generate file context gen
-    in do
-        generated ?> \file -> do
-            let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
-            (src, builder) <- unpack <$> findGenerator context file
-            need [src]
-            build $ target context builder [src] [file]
-            let boot = src -<.> "hs-boot"
-            whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
-
-        priority 2.0 $ do
-            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
-                root <- buildRoot
-                need $ [root -/- platformH stage, primopsSource]
-                    ++ fmap (root -/-) includesDependencies
-                build $ target context HsCpp [primopsSource] [file]
-
-            "//" ++ platformH stage %> go generateGhcBootPlatformH
-
-        -- TODO: why different folders for generated files?
-        priority 2.0 $ fmap (("//" ++ dir) -/-)
-            [ "GHC/Prim.hs"
-            , "GHC/PrimopWrappers.hs"
-            , "*.hs-incl" ] |%> \file -> do
-                root <- buildRoot
-                need [root -/- primopsTxt stage]
-                build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
-
-        when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file ->
-            build $ target context GenApply [] [file]
-
--- TODO: These rules copy runtime dependencies of some executables, such as GHC
--- itself (file @ghc-usage.txt@) or Hsc2Hs (file @template-hsc.h@). Ideally,
--- these rules should be moved to package-specific settings, so that they can be
--- discovered more easily. We also need to add proper support for runtime
--- dependencies on directories, which is the case for Haddock -- for the current
--- workaround see "Rules.Documentation.haddockHtmlResourcesStamp".
+    generated ?> \file -> do
+      let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
+      (src, builder) <- unpack <$> findGenerator context file
+      need [src]
+      build $ target context builder [src] [file]
+      let boot = src -<.> "hs-boot"
+      whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
+
+    priority 2.0 $ do
+        when (pkg == compiler) $ do root <//> dir -/- "Config.hs" %> go generateConfigHs
+                                    root <//> dir -/- "*.hs-incl" %> genPrimopCode context
+        when (pkg == ghcPrim) $ do (root <//> dir -/- "GHC/Prim.hs") %> genPrimopCode context
+                                   (root <//> dir -/- "GHC/PrimopWrappers.hs") %> genPrimopCode context
+        when (pkg == ghcPkg) $ do root <//> dir -/- "Version.hs" %> go generateVersionHs
+
+    -- TODO: needing platformH is ugly and fragile
+    when (pkg == compiler) $ do
+        root -/- primopsTxt stage %> \file -> do
+            root <- buildRoot
+            need $ [ root -/- platformH stage
+                   , primopsSource]
+                ++ fmap (root -/-) includesDependencies
+            build $ target context HsCpp [primopsSource] [file]
+
+        -- only generate this once! Until we have the include logic fixed.
+        -- See the note on `platformH`
+        when (stage == Stage0) $ do
+           root <//> "compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH
+        root <//> platformH stage %> go generateGhcBootPlatformH
+
+    when (pkg == rts) $ do
+      root <//> dir -/- "cmm/AutoApply.cmm" %> \file ->
+        build $ target context GenApply [] [file]
+
+      -- XXX: this should be fixed properly, e.g. generated here on demand.
+      (root <//> dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir))
+      (root <//> dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir))
+      (root <//> dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir))
+      (root <//> dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir))
+    when (pkg == integerGmp) $ do
+      (root <//> dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include"))
+ where
+    pattern <~ mdir = pattern %> \file -> do
+        dir <- mdir
+        copyFile (dir -/- takeFileName file) file
+
+genPrimopCode :: Context -> FilePath -> Action ()
+genPrimopCode context@(Context stage _pkg _) file = do
+    root <- buildRoot
+    need [root -/- primopsTxt stage]
+    build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
+
 copyRules :: Rules ()
 copyRules = do
 copyRules :: Rules ()
 copyRules = do
-    (inplaceLibPath -/- "ghc-usage.txt")     <~ return "driver"
-    (inplaceLibPath -/- "ghci-usage.txt"  )  <~ return "driver"
-    (inplaceLibPath -/- "llvm-targets")      <~ return "."
-    (inplaceLibPath -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir))
-    (inplaceLibPath -/- "settings")          <~ return "."
-    (inplaceLibPath -/- "template-hsc.h")    <~ return (pkgPath hsc2hs)
+    root <- buildRootRules
+    forM_ [Stage0 ..] $ \stage -> do
+      let prefix = root -/- stageString stage -/- "lib"
+      (prefix -/- "ghc-usage.txt")     <~ return "driver"
+      (prefix -/- "ghci-usage.txt"  )  <~ return "driver"
+      (prefix -/- "llvm-targets")      <~ return "."
+      (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir))
+      (prefix -/- "settings")          <~ return "."
+      (prefix -/- "template-hsc.h")    <~ return (pkgPath hsc2hs)
   where
     pattern <~ mdir = pattern %> \file -> do
         dir <- mdir
   where
     pattern <~ mdir = pattern %> \file -> do
         dir <- mdir
@@ -159,16 +175,18 @@ copyRules = do
 
 generateRules :: Rules ()
 generateRules = do
 
 generateRules :: Rules ()
 generateRules = do
-    priority 2.0 $ ("//" ++ generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH
-    priority 2.0 $ ("//" ++ generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH
-    priority 2.0 $ ("//" ++ generatedDir -/-  "ghcversion.h") <~ generateGhcVersionH
+    root <- buildRootRules
+    priority 2.0 $ (root -/- generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH
+    priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH
+    priority 2.0 $ (root -/- generatedDir -/-  "ghcversion.h") <~ generateGhcVersionH
 
 
-    ghcSplitPath %> \_ -> do
-        generate ghcSplitPath emptyTarget generateGhcSplit
-        makeExecutable ghcSplitPath
+    forM_ [Stage0 ..] $ \stage ->
+      root -/- ghcSplitPath stage %> \path -> do
+        generate path emptyTarget generateGhcSplit
+        makeExecutable path
 
     -- TODO: simplify, get rid of fake rts context
 
     -- TODO: simplify, get rid of fake rts context
-    "//" ++ generatedDir ++ "//*" %> \file -> do
+    root -/- generatedDir ++ "//*" %> \file -> do
         withTempDir $ \dir -> build $
             target rtsContext DeriveConstants [] [file, dir]
   where
         withTempDir $ \dir -> build $
             target rtsContext DeriveConstants [] [file, dir]
   where
@@ -350,7 +368,7 @@ generateConfigHs = do
         , "cLibFFI               :: Bool"
         , "cLibFFI               = " ++ show cLibFFI
         , "cGhcThreaded :: Bool"
         , "cLibFFI               :: Bool"
         , "cLibFFI               = " ++ show cLibFFI
         , "cGhcThreaded :: Bool"
-        , "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
+        , "cGhcThreaded = " ++ show (any (wayUnit Threaded) rtsWays)
         , "cGhcDebugged :: Bool"
         , "cGhcDebugged = " ++ show debugged
         , "cGhcRtsWithLibdw :: Bool"
         , "cGhcDebugged :: Bool"
         , "cGhcDebugged = " ++ show debugged
         , "cGhcRtsWithLibdw :: Bool"
index 46fad8a..89a88e4 100644 (file)
@@ -1,5 +1,5 @@
 module Rules.Gmp (
 module Rules.Gmp (
-    gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH, gmpBuildInfoPath
+    gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH
     ) where
 
 import Base
     ) where
 
 import Base
@@ -24,7 +24,7 @@ gmpContext = vanillaContext Stage1 integerGmp
 
 -- | Build directory for in-tree GMP library.
 gmpBuildPath :: Action FilePath
 
 -- | Build directory for in-tree GMP library.
 gmpBuildPath :: Action FilePath
-gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
+gmpBuildPath = buildRoot <&> (-/- buildDir gmpContext -/- "gmp")
 
 -- | GMP library header, relative to 'gmpBuildPath'.
 gmpLibraryH :: FilePath
 
 -- | GMP library header, relative to 'gmpBuildPath'.
 gmpLibraryH :: FilePath
@@ -34,10 +34,6 @@ gmpLibraryH = "include/ghc-gmp.h"
 gmpObjectsDir :: FilePath
 gmpObjectsDir = "objs"
 
 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
                                 , builderEnvironment "AR" (Ar Unpack Stage1)
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
                                 , builderEnvironment "AR" (Ar Unpack Stage1)
@@ -46,9 +42,10 @@ configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
 gmpRules :: Rules ()
 gmpRules = do
     -- Copy appropriate GMP header and object files
 gmpRules :: Rules ()
 gmpRules = do
     -- Copy appropriate GMP header and object files
-    "//" ++ gmpLibraryH %> \header -> do
+    root <- buildRootRules
+    root <//> gmpLibraryH %> \header -> do
         windows  <- windowsHost
         windows  <- windowsHost
-        configMk <- readFile' $ gmpBase -/- "config.mk"
+        configMk <- readFile' =<< (gmpBuildPath <&> (-/- "config.mk"))
         if not windows && -- TODO: We don't use system GMP on Windows. Fix?
            any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
         then do
         if not windows && -- TODO: We don't use system GMP on Windows. Fix?
            any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
         then do
@@ -66,24 +63,27 @@ gmpRules = do
             copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
 
     -- Build in-tree GMP library
             copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
 
     -- Build in-tree GMP library
-    "//" ++ gmpLibrary %> \lib -> do
+    root <//> 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 by the gmpLibraryH rule
         gmpPath <- gmpBuildPath
         build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
         putSuccess "| Successfully built custom library 'gmp'"
 
     -- In-tree GMP header is built by the gmpLibraryH rule
-    "//" ++ gmpLibraryInTreeH %> \_ -> do
+    root <//> gmpLibraryInTreeH %> \_ -> do
         gmpPath <- gmpBuildPath
         need [gmpPath -/- gmpLibraryH]
 
     -- This causes integerGmp package to be configured, hence creating the files
         gmpPath <- gmpBuildPath
         need [gmpPath -/- gmpLibraryH]
 
     -- This causes integerGmp package to be configured, hence creating the files
-    [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do
-        dataFile <- pkgDataFile gmpContext
-        need [dataFile]
+    root <//> "gmp/config.mk" %> \_ -> do
+        -- setup-config, triggers `ghc-cabal configure`
+        -- everything of a package should depend on that
+        -- in the first place.
+        setupConfig <- contextPath gmpContext <&> (-/- "setup-config")
+        need [setupConfig]
 
     -- Run GMP's configure script
     -- TODO: Get rid of hard-coded @gmp@.
 
     -- Run GMP's configure script
     -- TODO: Get rid of hard-coded @gmp@.
-    "//gmp/Makefile" %> \mk -> do
+    root <//> "gmp/Makefile" %> \mk -> do
         env     <- configureEnvironment
         gmpPath <- gmpBuildPath
         need [mk <.> "in"]
         env     <- configureEnvironment
         gmpPath <- gmpBuildPath
         need [mk <.> "in"]
@@ -91,7 +91,7 @@ gmpRules = do
             target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
 
     -- Extract in-tree GMP sources and apply patches
             target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
 
     -- Extract in-tree GMP sources and apply patches
-    "//gmp/Makefile.in" %> \_ -> do
+    root <//> "gmp/Makefile.in" %> \_ -> do
         gmpPath <- gmpBuildPath
         removeDirectory gmpPath
         -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
         gmpPath <- gmpBuildPath
         removeDirectory gmpPath
         -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs
deleted file mode 100644 (file)
index 190bc48..0000000
+++ /dev/null
@@ -1,349 +0,0 @@
-module Rules.Install (installRules) where
-
-import Hadrian.Oracles.DirectoryContents
-import qualified System.Directory as IO
-
-import Base
-import Expression
-import Oracles.Setting
-import Rules
-import Rules.Generate
-import Rules.Libffi
-import Rules.Wrappers
-import Settings
-import Settings.Packages.Rts
-import Target
-import Utilities
-
-{- | Install the built binaries etc. to the @destDir ++ prefix@.
-
-The installation prefix is usually @/usr/local@ on a Unix system.
-The resulting tree structure is organized under @destDir ++ prefix@ as follows:
-
-* @bin@: executable wrapper scripts, installed by 'installBins', e.g. @ghc@.
-
-* @lib/ghc-<version>/bin@: executable binaries/scripts,
-  installed by 'installLibExecs' and 'installLibExecScripts'.
-
-* @lib/ghc-<version>/include@: headers etc., installed by 'installIncludes'.
-
-* @lib/ghc-<version>/<pkg-name>@: built packages, e.g. @base@, installed
-  by 'installPackages'.
-
-* @lib/ghc-<version>/settings@ etc.: other files in @lib@ directory,
-  installed by 'installCommonLibs'.
-
-XXX (izgzhen): Do we need @INSTALL_OPTS@ in the make scripts?
--}
-installRules :: Rules ()
-installRules =
-    "install" ~> do
-        installIncludes
-        installPackageConf
-        installCommonLibs
-        installLibExecs
-        installLibExecScripts
-        installBins
-        installPackages
-        installDocs
-
--- TODO: Get rid of hard-coded list.
--- | Binaries to install.
-installBinPkgs :: [Package]
-installBinPkgs = [ghc, ghcPkg, ghcSplit, hp2ps, hpc, hsc2hs, runGhc, unlit]
-
-getLibExecDir :: Action FilePath
-getLibExecDir = installGhcLibDir <&> (-/- "bin")
-
--- 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"
-
--- ref: ghc.mk
--- | Install executable scripts to @prefix/lib/bin@.
-installLibExecScripts :: Action ()
-installLibExecScripts = do
-    libExecDir <- getLibExecDir
-    destDir <- getDestDir
-    installDirectory (destDir ++ libExecDir)
-    forM_ libExecScripts $ \script -> installScript script (destDir ++ libExecDir)
-  where
-    libExecScripts :: [FilePath]
-    libExecScripts = [ghcSplitPath]
-
--- ref: ghc.mk
--- | Install executable binaries to @prefix/lib/bin@.
-installLibExecs :: Action ()
-installLibExecs = do
-    libExecDir <- getLibExecDir
-    destDir <- getDestDir
-    installDirectory (destDir ++ libExecDir)
-    forM_ installBinPkgs $ \pkg ->
-        withInstallStage pkg $ \stage -> do
-            context <- programContext stage pkg
-            let bin = inplaceLibBinPath -/- programName context <.> exe
-            installProgram bin (destDir ++ libExecDir)
-            when (pkg == ghc) $
-                moveFile (destDir ++ libExecDir -/- programName context <.> exe)
-                         (destDir ++ libExecDir -/- "ghc" <.> exe)
-
--- ref: ghc.mk
--- | Install executable wrapper scripts to @prefix/bin@.
-installBins :: Action ()
-installBins = do
-    binDir <- setting InstallBinDir
-    libDir <- installGhcLibDir
-    destDir <- getDestDir
-    installDirectory (destDir ++ binDir)
-    win <- windowsHost
-    when win $
-        copyDirectoryContents matchAll (destDir ++ libDir -/- "bin") (destDir ++ binDir)
-    unless win $ forM_ installBinPkgs $ \pkg ->
-        withInstallStage pkg $ \stage -> do
-            context <- programContext stage pkg
-            version <- setting ProjectVersion
-            -- Name of the binary file
-            let binName | pkg == ghc = "ghc-" ++ version <.> exe
-                        | otherwise  = programName context ++ "-" ++ version <.> exe
-            -- Name of the symbolic link
-            let symName | pkg == ghc = "ghc" <.> exe
-                        | otherwise  = programName context <.> exe
-            case lookup context installWrappers of
-                Nothing -> return ()
-                Just wrapper -> do
-                    contents <- interpretInContext context $
-                        wrapper (WrappedBinary (destDir ++ libDir) symName)
-                    let wrapperPath = destDir ++ binDir -/- binName
-                    writeFileChanged wrapperPath contents
-                    makeExecutable wrapperPath
-                    unlessM windowsHost $
-                        linkSymbolic (destDir ++ binDir -/- binName)
-                                     (destDir ++ binDir -/- symName)
-
--- | Perform an action depending on the install stage or do nothing if the
--- package is not installed.
-withInstallStage :: Package -> (Stage -> Action ()) -> Action ()
-withInstallStage pkg m = do
-    maybeStage <- installStage pkg
-    case maybeStage of { 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
--- recreated each time.
-installPackageConf :: Action ()
-installPackageConf = do
-    let context = vanillaContext Stage0 rts
-    confPath <- pkgConfInstallPath
-    liftIO $ IO.createDirectoryIfMissing True (takeDirectory confPath)
-    build $ target context HsCpp [ pkgPath rts -/- "package.conf.in" ]
-                                 [ confPath <.> "raw" ]
-    Stdout content <- cmd "grep" [ "-v", "^#pragma GCC"
-                                 , confPath <.> "raw" ]
-    withTempFile $ \tmp -> do
-        liftIO $ writeFile tmp content
-        Stdout result <- cmd "sed" [ "-e", "s/\"\"//g", "-e", "s/:[   ]*,/: /g", tmp ]
-        liftIO $ writeFile confPath result
-
--- ref: ghc.mk
--- | Install packages to @prefix/lib@.
-installPackages :: Action ()
-installPackages = do
-    confPath <- pkgConfInstallPath
-    need [confPath]
-
-    ghcLibDir <- installGhcLibDir
-    binDir    <- setting InstallBinDir
-    destDir   <- getDestDir
-
-    -- Install package.conf
-    let installedPackageConf = destDir ++ ghcLibDir -/- "package.conf.d"
-    installDirectory (destDir ++ ghcLibDir)
-    removeDirectory installedPackageConf
-    installDirectory installedPackageConf
-
-    -- Install RTS
-    let rtsDir = destDir ++ ghcLibDir -/- "rts"
-    installDirectory rtsDir
-    ways    <- interpretInContext (vanillaContext Stage1 rts) getRtsWays
-    rtsLibs <- mapM (pkgLibraryFile . Context Stage1 rts) ways
-    ffiLibs <- mapM rtsLibffiLibrary ways
-
-    -- TODO: Add dynamic libraries.
-    forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir
-
-    -- TODO: Remove this hack required for @ghc-cabal copy@.
-    -- See https://github.com/snowleopard/hadrian/issues/327.
-    ghcBootPlatformHeader <-
-        buildPath (vanillaContext Stage1 compiler) <&> (-/- "ghc_boot_platform.h")
-    copyFile ghcBootPlatformHeader (pkgPath compiler -/- "ghc_boot_platform.h")
-
-    installPackages <- filterM ((isJust <$>) . installStage)
-                               (knownPackages \\ [rts, libffi])
-
-    installLibPkgs <- topsortPackages (filter isLibrary installPackages)
-
-    -- TODO: Figure out what is the root cause of the missing ghc-gmp.h error.
-    copyFile (pkgPath integerGmp -/- "gmp/ghc-gmp.h") (pkgPath integerGmp -/- "ghc-gmp.h")
-
-    forM_ installLibPkgs $ \pkg ->
-        case pkgCabalFile pkg of
-            Nothing -> error $ "Non-Haskell project in installLibPkgs" ++ show pkg
-            Just cabalFile -> withInstallStage pkg $ \stage -> do
-                let context = vanillaContext stage pkg
-                top <- topDirectory
-                installDistDir <- buildPath context
-                let absInstallDistDir = top -/- installDistDir
-
-                need =<< packageTargets True stage pkg
-                docDir <- installDocDir
-                ghclibDir <- installGhcLibDir
-
-                -- Copy over packages
-                strip <- stripCmdPath
-                ways  <- interpretInContext context getLibraryWays
-                -- TODO: Remove hard-coded @ghc-cabal@ path.
-                let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" <.> exe
-                need [ghcCabalInplace]
-
-                pkgConf <- pkgConfFile context
-                need [cabalFile, pkgConf] -- TODO: Check if we need 'pkgConf'.
-
-                -- TODO: Drop redundant copies required by @ghc-cabal@.
-                -- See https://github.com/snowleopard/hadrian/issues/318.
-                quietly $ copyDirectoryContentsUntracked (Not excluded)
-                    installDistDir (installDistDir -/- "build")
-
-                pref <- setting InstallPrefix
-                unit $ cmd ghcCabalInplace [ "copy"
-                                           , pkgPath pkg
-                                           , absInstallDistDir
-                                           , strip
-                                           , destDir
-                                           , pref
-                                           , ghclibDir
-                                           , docDir -/- "html/libraries"
-                                           , unwords (map show ways) ]
-
-    -- Register packages
-    let installedGhcPkgReal = destDir ++ binDir -/- "ghc-pkg" <.> exe
-        installedGhcReal    = destDir ++ binDir -/- "ghc"     <.> exe
-    -- TODO: Extend GhcPkg builder args to support --global-package-db
-    unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db"
-                                   , installedPackageConf, "update"
-                                   , confPath ]
-
-    forM_ installLibPkgs $ \pkg ->
-        withInstallStage pkg $ \stage -> do
-            let context = vanillaContext stage pkg
-            top <- topDirectory
-            installDistDir <- (top -/-) <$> buildPath context
-            -- TODO: better reference to the built inplace binary path
-            let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal"
-            pref   <- setting InstallPrefix
-            docDir <- installDocDir
-            r      <- relocatableBuild
-            unit $ cmd ghcCabalInplace
-                [ "register"
-                , pkgPath pkg
-                , installDistDir
-                , installedGhcReal
-                , installedGhcPkgReal
-                , destDir ++ ghcLibDir
-                , destDir
-                , destDir ++ pref
-                , destDir ++ ghcLibDir
-                , destDir ++ docDir -/- "html/libraries"
-                , if r then "YES" else "NO" ]
-
-    confs <- getDirectoryContents installedPackageConf
-    forM_ confs (\f -> createData $ installedPackageConf -/- f)
-    unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db"
-                                   , installedPackageConf, "recache" ]
-  where
-    createData f = unit $ cmd "chmod" [ "644", f ]
-    excluded = Or [ Test "//haddock-prologue.txt"
-                  , Test "//package-data.mk"
-                  , Test "//setup-config"
-                  , Test "//inplace-pkg-config"
-                  , Test "//build" ]
-
--- ref: ghc.mk
--- | Install settings etc. files to @prefix/lib@.
-installCommonLibs :: Action ()
-installCommonLibs = do
-    ghcLibDir <- installGhcLibDir
-    destDir   <- getDestDir
-    installLibsTo inplaceLibCopyTargets (destDir ++ ghcLibDir)
-
--- ref: ghc.mk
--- | Install library files to some path.
-installLibsTo :: [FilePath] -> FilePath -> Action ()
-installLibsTo libs dir = do
-    installDirectory dir
-    forM_ libs $ \lib -> case takeExtension lib of
-        ".a" -> do
-            let out = dir -/- takeFileName lib
-            installData [out] dir
-            runBuilder Ranlib [out] [out] [out]
-        _ -> installData [lib] dir
-
--- ref: includes/ghc.mk
--- | All header files are in includes/{one of these subdirectories}.
-includeHSubdirs :: [FilePath]
-includeHSubdirs = [".", "rts", "rts/prof", "rts/storage", "stg"]
-
--- ref: includes/ghc.mk
--- | Install header files to @prefix/lib/ghc-<version>/include@.
-installIncludes :: Action ()
-installIncludes = do
-    ghclibDir <- installGhcLibDir
-    destDir   <- getDestDir
-    let ghcheaderDir = ghclibDir -/- "include"
-    installDirectory (destDir ++ ghcheaderDir)
-    forM_ includeHSubdirs $ \dir -> do
-        installDirectory (destDir ++ ghcheaderDir -/- dir)
-        headers <- getDirectoryFiles ("includes" -/- dir) ["*.h"]
-        installHeader (map (("includes" -/- dir) -/-) headers)
-                      (destDir ++ ghcheaderDir -/- dir ++ "/")
-    root    <- buildRoot
-    rtsPath <- rtsBuildPath
-    installHeader (fmap (root -/-) includesDependencies ++
-                   [root -/- generatedDir -/- "DerivedConstants.h"] ++
-                   fmap (rtsPath -/-) libffiDependencies)
-                  (destDir ++ ghcheaderDir ++ "/")
-  where
-    installHeader = installData -- they share same arguments
-
--- ref: ghc.mk
--- | Install documentation to @prefix/share/doc/ghc-<version>@.
-installDocs :: Action ()
-installDocs = do
-    destDir <- getDestDir
-    docDir  <- installDocDir
-    root    <- buildRoot
-    installDirectory (destDir ++ docDir)
-
-    let usersGuide = root -/- "docs/pdfs/users_guide.pdf"
-    whenM (doesFileExist usersGuide) $
-        installData [usersGuide] (destDir ++ docDir)
-
-    let htmlDocDir = destDir ++ docDir -/- "html"
-    installDirectory htmlDocDir
-    installData ["docs/index.html"] htmlDocDir
-
-    forM_ ["Haddock", "libraries", "users_guide"] $ \dirname -> do
-        let dir = root -/- "docs/html" -/- dirname
-        whenM (doesDirectoryExist dir) $ copyDirectory dir htmlDocDir
index 73f481d..9351eb6 100644 (file)
@@ -1,7 +1,7 @@
 module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
 
 module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
 
+import GHC.Packages
 import Hadrian.Utilities
 import Hadrian.Utilities
-
 import Settings.Builders.Common
 import Settings.Packages.Rts
 import Target
 import Settings.Builders.Common
 import Settings.Packages.Rts
 import Target
@@ -37,7 +37,7 @@ configureEnvironment = do
     ldFlags <- interpretInContext libffiContext ldArgs
     sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
              , builderEnvironment "CXX" $ Cc CompileC Stage1
     ldFlags <- interpretInContext libffiContext ldArgs
     sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
              , builderEnvironment "CXX" $ Cc CompileC Stage1
-             , builderEnvironment "LD" Ld
+             , builderEnvironment "LD" (Ld Stage1)
              , builderEnvironment "AR" (Ar Unpack Stage1)
              , builderEnvironment "NM" Nm
              , builderEnvironment "RANLIB" Ranlib
              , builderEnvironment "AR" (Ar Unpack Stage1)
              , builderEnvironment "NM" Nm
              , builderEnvironment "RANLIB" Ranlib
@@ -46,11 +46,12 @@ configureEnvironment = do
 
 libffiRules :: Rules ()
 libffiRules = do
 
 libffiRules :: Rules ()
 libffiRules = do
-    fmap ("//rts" -/-) libffiDependencies &%> \_ -> do
+    root <- buildRootRules
+    fmap ((root <//> "rts/build") -/-) libffiDependencies &%> \_ -> do
         libffiPath <- libffiBuildPath
         need [libffiPath -/- libffiLibrary]
 
         libffiPath <- libffiBuildPath
         need [libffiPath -/- libffiLibrary]
 
-    "//" ++ libffiLibrary %> \_ -> do
+    root <//> libffiLibrary %> \_ -> do
         useSystemFfi <- flag UseSystemFfi
         rtsPath      <- rtsBuildPath
         if useSystemFfi
         useSystemFfi <- flag UseSystemFfi
         rtsPath      <- rtsBuildPath
         if useSystemFfi
@@ -75,7 +76,7 @@ libffiRules = do
 
             putSuccess "| Successfully built custom library 'libffi'"
 
 
             putSuccess "| Successfully built custom library 'libffi'"
 
-    "//libffi/Makefile.in" %> \mkIn -> do
+    root <//> "libffi/build/Makefile.in" %> \mkIn -> do
         libffiPath <- libffiBuildPath
         removeDirectory libffiPath
         tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
         libffiPath <- libffiBuildPath
         removeDirectory libffiPath
         tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
@@ -97,7 +98,7 @@ libffiRules = do
         fixFile mkIn (fixLibffiMakefile top)
 
     -- TODO: Get rid of hard-coded @libffi@.
         fixFile mkIn (fixLibffiMakefile top)
 
     -- TODO: Get rid of hard-coded @libffi@.
-    "//libffi/Makefile" %> \mk -> do
+    root <//> "libffi/build/Makefile" %> \mk -> do
         need [mk <.> "in"]
         libffiPath <- libffiBuildPath
         forM_ ["config.guess", "config.sub"] $ \file ->
         need [mk <.> "in"]
         libffiPath <- libffiBuildPath
         forM_ ["config.guess", "config.sub"] $ \file ->
index 7b7a179..e9f8ff6 100644 (file)
@@ -3,20 +3,46 @@ module Rules.Library (
     ) where
 
 import Hadrian.Haskell.Cabal
     ) where
 
 import Hadrian.Haskell.Cabal
-import qualified System.Directory as IO
+import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId)
 
 import Base
 import Context
 import Expression hiding (way, package)
 import Flavour
 
 import Base
 import Context
 import Expression hiding (way, package)
 import Flavour
+import GHC.Packages
 import Oracles.ModuleFiles
 import Oracles.ModuleFiles
-import Oracles.PackageData
 import Oracles.Setting
 import Rules.Gmp
 import Settings
 import Target
 import Utilities
 
 import Oracles.Setting
 import Rules.Gmp
 import Settings
 import Target
 import Utilities
 
+import qualified System.Directory as IO
+
+archive :: Way -> String -> String
+archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a")
+
+-- | Building a library consist of building
+-- the artifacts, and copying it somewhere
+-- with cabal, and finally registering it
+-- with the compiler via cabal in the
+-- package database.
+--
+-- So we'll assume rules to build all the
+-- package artifacts, and provide rules for
+-- the any of the library artifacts.
+library :: Context -> Rules ()
+library context@Context{..} = do
+    root <- buildRootRules
+    pkgId <- case pkgCabalFile package of
+      Just file -> liftIO $ parseCabalPkgId file
+      Nothing   -> return (pkgName package)
+
+    root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ -> do
+        need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId]
+        return ()
+
 libraryObjects :: Context -> Action [FilePath]
 libraryObjects context@Context{..} = do
     hsObjs   <- hsObjects    context
 libraryObjects :: Context -> Action [FilePath]
 libraryObjects context@Context{..} = do
     hsObjs   <- hsObjects    context
@@ -36,7 +62,11 @@ libraryObjects context@Context{..} = do
 
 buildDynamicLib :: Context -> Rules ()
 buildDynamicLib context@Context{..} = do
 
 buildDynamicLib :: Context -> Rules ()
 buildDynamicLib context@Context{..} = do
-    let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
+    root <- buildRootRules
+    pkgId <- case pkgCabalFile package of
+      Just file -> liftIO $ parseCabalPkgId file
+      Nothing   -> return (pkgName package)
+    let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
     -- OS X
     libPrefix ++ "*.dylib" %> buildDynamicLibUnix
     -- Linux
     -- OS X
     libPrefix ++ "*.dylib" %> buildDynamicLibUnix
     -- Linux
@@ -51,8 +81,13 @@ buildDynamicLib context@Context{..} = do
 
 buildPackageLibrary :: Context -> Rules ()
 buildPackageLibrary context@Context {..} = do
 
 buildPackageLibrary :: Context -> Rules ()
 buildPackageLibrary context@Context {..} = do
-    let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
-    libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do
+    root <- buildRootRules
+    pkgId <- case pkgCabalFile package of
+      Just file -> liftIO (parseCabalPkgId file)
+      Nothing   -> return (pkgName package)
+    let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId
+        archive = libPrefix ++ (waySuffix way <.> "a")
+    archive %%> \a -> do
         objs <- libraryObjects context
         asuf <- libsuf way
         let isLib0 = ("//*-0" ++ asuf) ?== a
         objs <- libraryObjects context
         asuf <- libsuf way
         let isLib0 = ("//*-0" ++ asuf) ?== a
@@ -60,36 +95,45 @@ buildPackageLibrary context@Context {..} = do
         if isLib0 then build $ target context (Ar Pack stage) []   [a] -- TODO: Scan for dlls
                   else build $ target context (Ar Pack stage) objs [a]
 
         if isLib0 then build $ target context (Ar Pack stage) []   [a] -- TODO: Scan for dlls
                   else build $ target context (Ar Pack stage) objs [a]
 
-        synopsis <- traverse pkgSynopsis (pkgCabalFile package)
+        synopsis <- pkgSynopsis context
         unless isLib0 . putSuccess $ renderLibrary
             (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
             ++ show way ++ ").") a synopsis
 
         unless isLib0 . putSuccess $ renderLibrary
             (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
             ++ show way ++ ").") a synopsis
 
+    library context
+
 buildPackageGhciLibrary :: Context -> Rules ()
 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
 buildPackageGhciLibrary :: Context -> Rules ()
 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
-    let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package
-    libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
+    root <- buildRootRules
+    pkgId <- case pkgCabalFile package of
+      Just file -> liftIO $ parseCabalPkgId file
+      Nothing   -> return (pkgName package)
+
+    let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId
+        o = libPrefix ++ "*" ++ (waySuffix way <.> "o")
+    o %> \obj -> do
         objs <- allObjects context
         need objs
         objs <- allObjects context
         need objs
-        build $ target context Ld objs [obj]
+        build $ target context (Ld stage) objs [obj]
 
 allObjects :: Context -> Action [FilePath]
 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
 
 nonHsObjects :: Context -> Action [FilePath]
 nonHsObjects context = do
 
 allObjects :: Context -> Action [FilePath]
 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
 
 nonHsObjects :: Context -> Action [FilePath]
 nonHsObjects context = do
-    path    <- buildPath context
     cObjs   <- cObjects context
     cObjs   <- cObjects context
-    cmmSrcs <- pkgDataList (CmmSrcs path)
+    cmmSrcs <- interpretInContext context (getPackageData PD.cmmSrcs)
     cmmObjs <- mapM (objectPath context) cmmSrcs
     eObjs   <- extraObjects context
     return $ cObjs ++ cmmObjs ++ eObjs
 
 cObjects :: Context -> Action [FilePath]
 cObjects context = do
     cmmObjs <- mapM (objectPath context) cmmSrcs
     eObjs   <- extraObjects context
     return $ cObjs ++ cmmObjs ++ eObjs
 
 cObjects :: Context -> Action [FilePath]
 cObjects context = do
-    path <- buildPath context
-    srcs <- pkgDataList (CSrcs path)
-    mapM (objectPath context) srcs
+    srcs <- interpretInContext context (getPackageData PD.cSrcs)
+    objs <- mapM (objectPath context) srcs
+    return $ if way context == threaded
+        then objs
+        else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
 
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
 
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
index 32a9117..96e9960 100644 (file)
@@ -3,115 +3,31 @@ module Rules.PackageData (buildPackageData) where
 import Base
 import Context
 import Expression
 import Base
 import Context
 import Expression
-import Oracles.Setting
-import Rules.Generate
+import GHC.Packages
 import Settings.Packages.Rts
 import Target
 import Utilities
 
 import Settings.Packages.Rts
 import Target
 import Utilities
 
--- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
+import Hadrian.Haskell.Cabal.Parse (configurePackage)
+
+-- | Build @setup-config@ and @inplace-pkg-config@ files
+--   for packages. Look at the "Rules" module to see this
+--   instantiated against all the packages.
 buildPackageData :: Context -> Rules ()
 buildPackageData context@Context {..} = do
 buildPackageData :: Context -> Rules ()
 buildPackageData context@Context {..} = do
-    let dir       = "//" ++ contextDir context
-        cabalFile = unsafePkgCabalFile package -- TODO: improve
-        configure = pkgPath package -/- "configure"
-    -- 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
-
-        -- GhcCabal may run the configure script, so we depend on it.
-        whenM (doesFileExist $ configure <.> "ac") $ need [configure]
-
-        -- Before we configure a package its dependencies need to be registered.
-        need =<< mapM pkgConfFile =<< contextDependencies context
+    root <- buildRootRules
+    let dir = root -/- contextDir context
+    dir -/- "setup-config" %> \_ -> configurePackage context
 
 
-        need [cabalFile]
-        build $ target context GhcCabal [cabalFile] [mk, setupConfig]
-        postProcessPackageData context mk
-
-    -- TODO: Get rid of hardcoded file paths.
     dir -/- "inplace-pkg-config" %> \conf -> do
     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" rtsPath
-                         . replace "includes/dist-derivedconstants/header" genPath )
-                         . lines
-        else
-            fixFile conf $ unlines . map (replace (path </> "build") path) . lines
-
-    priority 2.0 $ when (nonCabalContext context) $ dir -/- "package-data.mk" %>
-        generatePackageData context
-
-generatePackageData :: Context -> FilePath -> Action ()
-generatePackageData context@Context {..} file = do
-    orderOnly =<< interpretInContext context generatedDependencies
-    asmSrcs <- packageAsmSources package
-    cSrcs   <- packageCSources   package
-    cmmSrcs <- packageCmmSources package
-    genPath <- buildRoot <&> (-/- generatedDir)
-    writeFileChanged file . unlines $
-        [ "S_SRCS = "   ++ unwords asmSrcs                                  ] ++
-        [ "C_SRCS = "   ++ unwords cSrcs                                    ] ++
-        [ "CMM_SRCS = " ++ unwords cmmSrcs                                  ] ++
-        [ "DEP_EXTRA_LIBS = m"                 | package == hp2ps           ] ++
-        [ "CC_OPTS = -I" ++ genPath            | package `elem` [hp2ps, rts]] ++
-        [ "MODULES = Main"                     | package == ghcCabal        ] ++
-        [ "HS_SRC_DIRS = ."                    | package == ghcCabal        ]
-    putSuccess $ "| Successfully generated " ++ file
-
-packageCSources :: Package -> Action [FilePath]
-packageCSources pkg
-    | pkg /= rts = getDirectoryFiles (pkgPath pkg) ["*.c"]
-    | otherwise  = do
-        windows <- windowsHost
-        sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) .
-            map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++
-                              [ if windows then "win32" else "posix"     ]
-        return sources
-
-packageAsmSources :: Package -> Action [FilePath]
-packageAsmSources pkg
-    | pkg /= rts = return []
-    | otherwise  = do
-        buildAdjustor   <- anyTargetArch ["i386", "powerpc", "powerpc64"]
-        buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
-        return $ [ "AdjustorAsm.S" | buildAdjustor   ]
-              ++ [ "StgCRunAsm.S"  | buildStgCRunAsm ]
-
-packageCmmSources :: Package -> Action [FilePath]
-packageCmmSources pkg
-    | pkg /= rts = return []
-    | otherwise  = do
+      when (package == rts) $ do
+        genPath <- buildRoot <&> (-/- generatedDir)
         rtsPath <- rtsBuildPath
         rtsPath <- rtsBuildPath
-        sources <- getDirectoryFiles (pkgPath pkg) ["*.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
--- @libraries/Win32_dist-install_CMM_SRCS  := $(addprefix cbits/,$(notdir ...@
--- and replace it with a tracked call to getDirectoryFiles.
--- 2) Drop path prefixes to individual settings.
--- For example, @libraries/deepseq/dist-install_VERSION = 1.4.0.0@
--- is replaced by @VERSION = 1.4.0.0@.
--- Reason: Shake's built-in makefile parser doesn't recognise slashes
--- TODO (izgzhen): should fix DEP_LIB_REL_DIRS_SEARCHPATH
-postProcessPackageData :: Context -> FilePath -> Action ()
-postProcessPackageData context@Context {..} file = do
-    top     <- topDirectory
-    cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"]
-    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
+        need [rtsConfIn]
+        build $ target context HsCpp [rtsConfIn] [conf]
+        fixFile conf $ unlines
+                     . map
+                     ( replace "\"\"" ""
+                     . replace "rts/dist/build" rtsPath
+                     . replace "includes/dist-derivedconstants/header" genPath )
+                     . lines
index dca177f..32a8eb8 100644 (file)
@@ -1,96 +1,59 @@
 module Rules.Program (buildProgram) where
 
 import Hadrian.Haskell.Cabal
 module Rules.Program (buildProgram) where
 
 import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.PackageData as PD
 
 import Base
 import Context
 import Expression hiding (stage, way)
 
 import Base
 import Context
 import Expression hiding (stage, way)
+import GHC
 import Oracles.ModuleFiles
 import Oracles.ModuleFiles
-import Oracles.PackageData
-import Oracles.Setting
-import Rules.Wrappers
+import Oracles.Flag (crossCompiling)
 import Settings
 import Settings.Packages.Rts
 import Target
 import Utilities
 
 -- | TODO: Drop code duplication
 import Settings
 import Settings.Packages.Rts
 import Target
 import Utilities
 
 -- | TODO: Drop code duplication
-buildProgram :: [(Resource, Int)] -> Package -> Rules ()
-buildProgram rs package = do
-    forM_ [Stage0 ..] $ \stage -> do
-        let context = vanillaContext stage package
+buildProgram :: [(Resource, Int)] -> Rules ()
+buildProgram rs = do
+    root <- buildRootRules
+    forM_ [Stage0 ..] $ \stage ->
+      root -/- stageString stage -/- "bin" -/- "*" %> \bin -> do
 
 
-        -- Rules for programs built in 'buildRoot'
-        "//" ++ contextDir context -/- programName context <.> exe %> \bin ->
-            buildBinaryAndWrapper rs bin =<< programContext stage package
+          -- quite inefficient. But we can't access the programName from
+          -- Rules, as it's an Action, due to being backed by an Oracle.
+          activeProgramPackages <- filter isProgram <$> stagePackages stage
+          nameToCtxList <- forM activeProgramPackages $ \pkg -> do
+            let ctx = vanillaContext stage pkg
+            name <- programName ctx
+            return (name <.> exe, ctx)
 
 
-        -- Rules for the GHC package, which is built 'inplace'
-        when (package == ghc) $ do
-            inplaceBinPath -/- programName context <.> exe %> \bin ->
-                buildBinaryAndWrapper rs bin =<< programContext stage package
+          case lookup (takeFileName bin) nameToCtxList of
+            Nothing -> fail "Unknown program"
+            Just (Context {..}) -> do
+              -- Rules for programs built in 'buildRoot'
 
 
-            inplaceLibBinPath -/- programName context <.> exe %> \bin ->
-                buildBinary rs bin =<< programContext stage package
+              -- Custom dependencies: this should be modeled better in the cabal file somehow.
 
 
-            inplaceLibBinPath -/- programName context <.> "bin" %> \bin ->
-                buildBinary rs bin =<< programContext stage package
+              when (package == hsc2hs) $ do
+                -- hsc2hs needs the template-hsc.h file
+                tmpl <- templateHscPath stage
+                need [tmpl]
+              when (package == ghc) $ do
+                -- ghc depends on settings, platformConstants, llvm-targets
+                --     ghc-usage.txt, ghci-usage.txt
+                need =<< ghcDeps stage
 
 
-    -- Rules for other programs built in inplace directories
-    when (package /= ghc) $ do
-        let context0 = vanillaContext Stage0 package -- TODO: get rid of context0
-        inplaceBinPath -/- programName context0 <.> exe %> \bin -> do
-            stage <- installStage package -- TODO: get rid of fromJust
-            buildBinaryAndWrapper rs bin =<< programContext (fromJust stage) package
-
-        inplaceLibBinPath -/- programName context0 <.> exe %> \bin -> do
-            stage   <- installStage package -- TODO: get rid of fromJust
-            context <- programContext (fromJust stage) package
-            if package /= iservBin then
-                -- We *normally* build only unwrapped binaries in inplace/lib/bin
-                buildBinary rs bin context
-            else
-                -- Build both binary and wrapper in inplace/lib/bin for iservBin
-                buildBinaryAndWrapperLib rs bin context
-
-        inplaceLibBinPath -/- programName context0 <.> "bin" %> \bin -> do
-            stage <- installStage package -- TODO: get rid of fromJust
-            buildBinary rs bin =<< programContext (fromJust stage) package
-
-buildBinaryAndWrapperLib :: [(Resource, Int)] -> FilePath -> Context -> Action ()
-buildBinaryAndWrapperLib rs bin context = do
-    windows <- windowsHost
-    if windows
-    then buildBinary rs bin context -- We don't build wrappers on Windows
-    else case lookup context inplaceWrappers of
-        Nothing      -> buildBinary rs bin context -- No wrapper found
-        Just wrapper -> do
-            top <- topDirectory
-            let libdir = top -/- inplaceLibPath
-            let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
-            need [wrappedBin]
-            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))
-
-buildBinaryAndWrapper :: [(Resource, Int)] -> FilePath -> Context -> Action ()
-buildBinaryAndWrapper rs bin context = do
-    windows <- windowsHost
-    if windows
-    then buildBinary rs bin context -- We don't build wrappers on Windows
-    else case lookup context inplaceWrappers of
-        Nothing      -> buildBinary rs bin context -- No wrapper found
-        Just wrapper -> do
-            top <- topDirectory
-            let libPath    = top -/- inplaceLibPath
-                wrappedBin = inplaceLibBinPath -/- takeFileName bin
-            need [wrappedBin]
-            buildWrapper context wrapper bin (WrappedBinary libPath (takeFileName bin))
-
-buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
-buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
-    contents <- interpretInContext context $ wrapper wrapped
-    writeFileChanged wrapperPath contents
-    makeExecutable wrapperPath
-    putSuccess $ "| Successfully created wrapper for " ++
-        quote (pkgName package) ++ " (" ++ show stage ++ ")."
+              cross <- crossCompiling
+              -- for cross compiler, copy the stage0/bin/<pgm>
+              -- into stage1/bin/
+              case (cross, stage) of
+                (True, s) | s > Stage0 -> do
+                              srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
+                              copyFile (srcDir -/- takeFileName bin) bin
+                _ -> buildBinary rs bin =<< programContext stage package
+          -- Rules for the GHC package, which is built 'inplace'
 
 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
 buildBinary rs bin context@Context {..} = do
 
 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
 buildBinary rs bin context@Context {..} = do
@@ -101,13 +64,12 @@ buildBinary rs bin context@Context {..} = do
             when (stage > Stage0) $ do
                 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
                 needLibrary [ rtsContext { way = w } | w <- ways ]
             when (stage > Stage0) $ do
                 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
                 needLibrary [ rtsContext { way = w } | w <- ways ]
-            path   <- buildPath context
-            cSrcs  <- pkgDataList (CSrcs path)
+            cSrcs  <- interpretInContext context (getPackageData PD.cSrcs)
             cObjs  <- mapM (objectPath context) cSrcs
             hsObjs <- hsObjects context
             return $ cObjs ++ hsObjs
     need binDeps
     buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
             cObjs  <- mapM (objectPath context) cSrcs
             hsObjs <- hsObjects context
             return $ cObjs ++ hsObjs
     need binDeps
     buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
-    synopsis <- traverse pkgSynopsis (pkgCabalFile package)
+    synopsis <- pkgSynopsis context
     putSuccess $ renderProgram
         (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
     putSuccess $ renderProgram
         (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
index 7c0a3e0..14b085d 100644 (file)
@@ -1,44 +1,97 @@
-module Rules.Register (registerPackage) where
+module Rules.Register (registerPackages) where
 
 import Base
 import Context
 import GHC
 
 import Base
 import Context
 import GHC
+import Settings
 import Target
 import Utilities
 
 import Target
 import Utilities
 
--- TODO: Simplify.
+import Distribution.ParseUtils
+import qualified Distribution.Compat.ReadP as Parse
+import Distribution.Version (Version)
+
+import Hadrian.Expression
+import Hadrian.Haskell.Cabal.Parse as Cabal
+
+parseCabalName :: String -> Maybe (String, Version)
+parseCabalName = readPToMaybe parse
+  where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
+
 -- | Build rules for registering packages and initialising package databases
 -- by running the @ghc-pkg@ utility.
 -- | Build rules for registering packages and initialising package databases
 -- by running the @ghc-pkg@ utility.
-registerPackage :: [(Resource, Int)] -> Context -> Rules ()
-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.
-        "//" ++ stage0PackageDbDir -/- pkgName package ++ "*.conf" %%>
-            buildConf rs context
+registerPackages :: [(Resource, Int)] -> Context -> Rules ()
+registerPackages rs context@Context {..} = do
+  root <- buildRootRules
+  root -/- relativePackageDbPath stage %>
+    buildStamp rs context
 
 
-        when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %>
-            buildStamp rs context
+  root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
+    writeFileLines stamp []
 
 
-    when (stage == Stage1) $ do
-        inplacePackageDbPath -/- pkgName package ++ "*.conf" %%>
-            buildConf rs context
+  root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
+    settings <- libPath context <&> (-/- "settings")
+    platformConstants <- libPath context <&> (-/- "platformConstants")
+    need [settings, platformConstants]
+    let Just pkgName | takeBaseName conf == "rts" = Just "rts"
+                     | otherwise = fst <$> parseCabalName (takeBaseName conf)
+    let Just pkg = findPackageByName pkgName
+    bootLibs <- filter isLibrary <$> stagePackages Stage0
+    case stage of
+      Stage0 | pkg `notElem` bootLibs -> copyConf rs (context { package = pkg }) conf
+      _                               -> buildConf rs (context { package = pkg }) conf
 
 
-        when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %>
-            buildStamp rs context
 
 buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 
 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]
+buildConf _ context@Context {..} _conf = do
+    depPkgIds <- cabalDependencies context
+
+    -- setup-config, triggers `ghc-cabal configure`
+    -- everything of a package should depend on that
+    -- in the first place.
+    setupConfig <- (contextPath context) <&> (-/- "setup-config")
+    need [setupConfig]
+    need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
+
+    ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)
+    need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ]
+
+    -- might need some package-db resource to limit read/write,
+    -- see packageRules
+    bldPath <- buildPath context
+
+    -- special package cases (these should ideally be rolled into cabal one way or the other)
+    when (package == rts) $
+      -- iif cabal new about "generated-headers", we could read them from the configuredCabal
+      -- information, and just "need" them here.
+      need [ bldPath -/- "DerivedConstants.h"
+           , bldPath -/- "ghcautoconf.h"
+           , bldPath -/- "ghcplatform.h"
+           , bldPath -/- "ghcversion.h"
+           , bldPath -/- "ffi.h"
+           ]
+
+    when (package == integerGmp) $
+      need [bldPath -/- "ghc-gmp.h"]
+
+    -- copy and register the package
+    copyPackage context
+    registerPackage context
+
+copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
+copyConf rs context@Context {..} conf = do
+    depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $
+      target context (GhcPkg Dependencies stage) [pkgName package] []
+    need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
+    buildWithResources rs $
+      target context (GhcPkg Clone stage) [pkgName package] [conf]
+
+  where
+    stdOutToPkgIds :: String -> [String]
+    stdOutToPkgIds = drop 1 . concatMap words . lines
 
 buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 
 buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildStamp rs Context {..} stamp = do
-    let path = takeDirectory stamp
-    removeDirectory path
+buildStamp rs Context {..} path = do
     buildWithResources rs $
         target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
     buildWithResources rs $
         target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
-    writeFileLines stamp []
     putSuccess $ "| Successfully initialised " ++ path
     putSuccess $ "| Successfully initialised " ++ path
index 3143c4b..a28da83 100644 (file)
@@ -12,7 +12,7 @@ sourceDistRules = do
     "sdist-ghc" ~> do
         -- We clean the source tree first.
         -- See https://github.com/snowleopard/hadrian/issues/384.
     "sdist-ghc" ~> do
         -- We clean the source tree first.
         -- See https://github.com/snowleopard/hadrian/issues/384.
-        cleanSourceTree
+        -- cleanSourceTree
         version <- setting ProjectVersion
         need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"]
         putSuccess "| Done"
         version <- setting ProjectVersion
         need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"]
         putSuccess "| Done"
index 1205051..426c049 100644 (file)
@@ -2,6 +2,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where
 
 import Base
 import Expression
 
 import Base
 import Expression
+import GHC.Packages
 import Oracles.Flag
 import Oracles.Setting
 import Target
 import Oracles.Flag
 import Oracles.Setting
 import Target
@@ -33,14 +34,12 @@ testRules = do
         makeExecutable (root -/- timeoutProgPath)
 
     "validate" ~> do
         makeExecutable (root -/- timeoutProgPath)
 
     "validate" ~> do
-        needBuilder $ Ghc CompileHs Stage2
-        needBuilder $ GhcPkg Update Stage1
-        needBuilder Hp2Ps
-        needBuilder Hpc
-        needBuilder Hsc2Hs
+        needTestBuilders
         build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
 
     "test" ~> do
         build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
 
     "test" ~> do
+        needTestBuilders
+
         -- Prepare the timeout program.
         need [ root -/- timeoutProgPath ]
 
         -- Prepare the timeout program.
         need [ root -/- timeoutProgPath ]
 
@@ -65,6 +64,15 @@ testRules = do
         -- Execute the test target.
         buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
 
         -- Execute the test target.
         buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] []
 
+needTestBuilders :: Action ()
+needTestBuilders = do
+  needBuilder $ Ghc CompileHs Stage2
+  needBuilder $ GhcPkg Update Stage1
+  needBuilder Hp2Ps
+  needBuilder Hpc
+  needBuilder (Hsc2Hs Stage1)
+
+
 -- | Extra flags to send to the Haskell compiler to run tests.
 runTestGhcFlags :: Action String
 runTestGhcFlags = do
 -- | Extra flags to send to the Haskell compiler to run tests.
 runTestGhcFlags :: Action String
 runTestGhcFlags = do
diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs
deleted file mode 100644 (file)
index 20763a7..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
-module Rules.Wrappers (
-    WrappedBinary(..), Wrapper, inplaceWrappers, installWrappers
-    ) where
-
-import Hadrian.Oracles.Path
-
-import Base
-import Expression
-import Oracles.Setting
-import Settings
-
--- | 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
-
-ghcWrapper :: WrappedBinary -> Expr String
-ghcWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-          ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
-
-inplaceRunGhcWrapper :: WrappedBinary -> Expr String
-inplaceRunGhcWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-          ++ " -f" ++ (binaryLibPath -/- "bin/ghc-stage2") -- TODO: use ProgramName
-          ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
-
-installRunGhcWrapper :: WrappedBinary -> Expr String
-installRunGhcWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-          ++ " -f" ++ (binaryLibPath -/- "bin/ghc") -- TODO: use ProgramName
-          ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
-
-inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
-inplaceGhcPkgWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    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 " ++ top -/- inplacePackageDbPath ++ " ${1+\"$@\"}" ]
-
-installGhcPkgWrapper :: WrappedBinary -> Expr String
-installGhcPkgWrapper 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.
-    packageDb <- expr $ installPackageDbPath binaryLibPath top (succ stage)
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-          ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
-
-hp2psWrapper :: WrappedBinary -> Expr String
-hp2psWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
-
-hpcWrapper :: WrappedBinary -> Expr String
-hpcWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
-
-hsc2hsWrapper :: WrappedBinary -> Expr String
-hsc2hsWrapper WrappedBinary{..} = do
-    top <- expr topDirectory
-    expr $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
-    contents <- expr $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
-    let executableName = binaryLibPath -/- "bin" -/- binaryName
-    confCcArgs <- expr $ settingList (ConfCcArgs Stage1)
-    confGccLinkerArgs <- expr $ settingList (ConfGccLinkerArgs Stage1)
-    let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++
-                      unwords (map ("-lflags=" ++) confGccLinkerArgs)
-    bash <- expr bashPath
-    return $ unlines
-        [ "#!"++bash
-        , "executablename=\"" ++ executableName ++ "\""
-        , "HSC2HS_EXTRA=\"" ++ hsc2hsExtra ++ "\""
-        , contents ]
-
-haddockWrapper :: WrappedBinary -> Expr String
-haddockWrapper WrappedBinary{..} = do
-  expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-  return $ unlines
-    [ "#!/bin/bash"
-    , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
-      ++ " -B" ++ binaryLibPath ++ " -l" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
-
-iservBinWrapper :: WrappedBinary -> Expr String
-iservBinWrapper WrappedBinary{..} = do
-    expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
-    stage <- getStage
-    stageLibraries <- expr $ filter isLibrary <$> stagePackages stage
-    -- TODO: Figure our the reason of this hardcoded exclusion
-    let pkgs = stageLibraries \\ [ cabal, process, haskeline
-                                 , terminfo, ghcCompact, hpc, compiler ]
-    contexts <- expr $ concatForM pkgs $ \p -> do
-        maybeStage <- installStage p
-        return [ vanillaContext s p | s <- maybeToList maybeStage ]
-    buildPaths <- expr $ mapM buildPath contexts
-    return $ unlines
-        [ "#!/bin/bash"
-        , "export DYLD_LIBRARY_PATH=\"" ++ intercalate ":" buildPaths ++
-          "${DYLD_LIBRARY_PATH:+:$DYLD_LIBRARY_PATH}\""
-       , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
-
-wrappersCommon :: [(Context, Wrapper)]
-wrappersCommon = [ (vanillaContext Stage0 ghc   , ghcWrapper)
-                 , (vanillaContext Stage1 ghc   , ghcWrapper)
-                 , (vanillaContext Stage1 hp2ps , hp2psWrapper)
-                 , (vanillaContext Stage1 hpc   , hpcWrapper)
-                 , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper)
-                 , (vanillaContext Stage2 haddock, haddockWrapper)
-                 , (vanillaContext Stage1 iservBin, iservBinWrapper) ]
-
--- | List of wrappers for inplace artefacts
-inplaceWrappers :: [(Context, Wrapper)]
-inplaceWrappers = wrappersCommon ++
-                  [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper)
-                  , (vanillaContext Stage1 runGhc, inplaceRunGhcWrapper) ]
-
--- | List of wrappers for installation
-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"
old mode 100644 (file)
new mode 100755 (executable)
index 091efc1..48ba4c2
@@ -1,12 +1,15 @@
 module Settings (
     getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
 module Settings (
     getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
-    findPackageByName, getPkgData, getPkgDataList, isLibrary, stagePackages,
+    findPackageByName, isLibrary, stagePackages,
     programContext, getIntegerPackage, getDestDir
     ) where
 
 import CommandLine
 import Expression
 import Flavour
     programContext, getIntegerPackage, getDestDir
     ) where
 
 import CommandLine
 import Expression
 import Flavour
+import GHC.Packages
+import UserSettings
+
 import {-# SOURCE #-} Settings.Default
 import Settings.Flavours.Development
 import Settings.Flavours.Performance
 import {-# SOURCE #-} Settings.Default
 import Settings.Flavours.Development
 import Settings.Flavours.Performance
@@ -14,7 +17,6 @@ import Settings.Flavours.Profiled
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
 import Settings.Flavours.QuickCross
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
 import Settings.Flavours.QuickCross
-import UserSettings
 
 getArgs :: Args
 getArgs = expr flavour >>= args
 
 getArgs :: Args
 getArgs = expr flavour >>= args
index fdd9fc5..c78a19d 100644 (file)
@@ -1,17 +1,18 @@
 module Settings.Builders.Cc (ccBuilderArgs) where
 
 module Settings.Builders.Cc (ccBuilderArgs) where
 
+import Hadrian.Haskell.Cabal.PackageData as PD
 import Settings.Builders.Common
 
 ccBuilderArgs :: Args
 ccBuilderArgs = do
     way <- getWay
     builder Cc ? mconcat
 import Settings.Builders.Common
 
 ccBuilderArgs :: Args
 ccBuilderArgs = do
     way <- getWay
     builder Cc ? mconcat
-        [ getPkgDataList CcArgs
+        [ getPackageData PD.ccOpts
         , getStagedSettingList ConfCcArgs
         , getStagedSettingList ConfCcArgs
-        , cIncludeArgs
 
         , builder (Cc CompileC) ? mconcat
             [ arg "-Wall"
 
         , builder (Cc CompileC) ? mconcat
             [ arg "-Wall"
+            , cIncludeArgs
             , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
             , arg "-c", arg =<< getInput
             , arg "-o", arg =<< getOutput ]
             , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
             , arg "-c", arg =<< getInput
             , arg "-o", arg =<< getOutput ]
@@ -22,5 +23,6 @@ ccBuilderArgs = do
                     , arg "-MM", arg "-MG"
                     , arg "-MF", arg output
                     , arg "-MT", arg $ dropExtension output -<.> "o"
                     , arg "-MM", arg "-MG"
                     , arg "-MF", arg output
                     , arg "-MT", arg $ dropExtension output -<.> "o"
+                    , cIncludeArgs
                     , arg "-x", arg "c"
                     , arg =<< getInput ] ]
                     , arg "-x", arg "c"
                     , arg =<< getInput ] ]
index bfcddeb..40e5d70 100644 (file)
@@ -2,17 +2,18 @@ module Settings.Builders.Common (
     module Base,
     module Expression,
     module Oracles.Flag,
     module Base,
     module Expression,
     module Oracles.Flag,
-    module Oracles.PackageData,
     module Oracles.Setting,
     module Settings,
     module UserSettings,
     module Oracles.Setting,
     module Settings,
     module UserSettings,
-    cIncludeArgs, ldArgs, cArgs, cWarnings, bootPackageDatabaseArgs
+    cIncludeArgs, ldArgs, cArgs, cWarnings,
+    packageDatabaseArgs, bootPackageDatabaseArgs
     ) where
 
 import Base
 import Expression
     ) where
 
 import Base
 import Expression
+import GHC.Packages
+import Hadrian.Haskell.Cabal.PackageData as PD
 import Oracles.Flag
 import Oracles.Flag
-import Oracles.PackageData
 import Oracles.Setting
 import Settings
 import UserSettings
 import Oracles.Setting
 import Settings
 import UserSettings
@@ -22,13 +23,24 @@ cIncludeArgs = do
     pkg     <- getPackage
     root    <- getBuildRoot
     path    <- getBuildPath
     pkg     <- getPackage
     root    <- getBuildRoot
     path    <- getBuildPath
-    incDirs <- getPkgDataList IncludeDirs
-    depDirs <- getPkgDataList DepIncludeDirs
+    incDirs <- getPackageData PD.includeDirs
+    depDirs <- getPackageData PD.depIncludeDirs
+    iconvIncludeDir <- getSetting IconvIncludeDir
+    gmpIncludeDir   <- getSetting GmpIncludeDir
+    ffiIncludeDir   <- getSetting FfiIncludeDir
+
     cross   <- expr crossCompiling
     compilerOrGhc <- package compiler ||^ package ghc
     mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes"
             , arg $ "-I" ++ root -/- generatedDir
             , arg $ "-I" ++ path
     cross   <- expr crossCompiling
     compilerOrGhc <- package compiler ||^ package ghc
     mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes"
             , arg $ "-I" ++ root -/- generatedDir
             , arg $ "-I" ++ path
+            , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir]
+            , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
+            -- add the build path with include dirs in case we generated
+            -- some files with autoconf, which will end up in the build directory.
+            , pure [ "-I" ++ path        -/- dir | dir <- incDirs ]
+            -- add the package directory with include dirs, for includes
+            -- shipped with the package
             , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ]
             , pure [ "-I" ++       unifyPath dir | dir <- depDirs ] ]
 
             , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ]
             , pure [ "-I" ++       unifyPath dir | dir <- depDirs ] ]
 
@@ -46,13 +58,19 @@ cWarnings = mconcat
     , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
     , notM (flag GccIsClang) ? arg "-Wno-error=inline" ]
 
     , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
     , notM (flag GccIsClang) ? arg "-Wno-error=inline" ]
 
+packageDatabaseArgs :: Args
+packageDatabaseArgs = do
+  stage <- getStage
+  dbPath <- expr (packageDbPath stage)
+  expr (need [dbPath -/- packageDbStamp])
+  top <- expr topDirectory
+  root <- getBuildRoot
+  prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
+  arg $ prefix ++ root -/- relativePackageDbPath stage
+
 bootPackageDatabaseArgs :: Args
 bootPackageDatabaseArgs = do
     stage  <- getStage
     dbPath <- expr $ packageDbPath stage
     expr $ need [dbPath -/- packageDbStamp]
 bootPackageDatabaseArgs :: Args
 bootPackageDatabaseArgs = do
     stage  <- getStage
     dbPath <- expr $ packageDbPath stage
     expr $ need [dbPath -/- packageDbStamp]
-    stage0 ? do
-        top    <- expr topDirectory
-        root   <- getBuildRoot
-        prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
-        arg $ prefix ++ top -/- root -/- stage0PackageDbDir
+    stage0 ? packageDatabaseArgs
index 7a6e863..bd7511b 100644 (file)
@@ -1,5 +1,6 @@
 module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where
 
 module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where
 
+import Builder
 import Settings.Builders.Common
 
 -- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
 import Settings.Builders.Common
 
 -- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
index 3fba00d..a018360 100644 (file)
@@ -1,12 +1,13 @@
 module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
 
 module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
 
-import Hadrian.Haskell.Cabal
-
 import Flavour
 import Flavour
-import Rules.Gmp
+import GHC
 import Settings.Builders.Common
 import Settings.Warnings
 
 import Settings.Builders.Common
 import Settings.Warnings
 
+import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.PackageData as PD
+
 ghcBuilderArgs :: Args
 ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
 
 ghcBuilderArgs :: Args
 ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
 
@@ -24,7 +25,7 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
 compileC :: Args
 compileC = builder (Ghc CompileCWithGhc) ? do
     way <- getWay
 compileC :: Args
 compileC = builder (Ghc CompileCWithGhc) ? do
     way <- getWay
-    let ccArgs = [ getPkgDataList CcArgs
+    let ccArgs = [ getPackageData PD.ccOpts
                  , getStagedSettingList ConfCcArgs
                  , cIncludeArgs
                  , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
                  , getStagedSettingList ConfCcArgs
                  , cIncludeArgs
                  , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
@@ -40,25 +41,18 @@ compileC = builder (Ghc CompileCWithGhc) ? do
 
 ghcLinkArgs :: Args
 ghcLinkArgs = builder (Ghc LinkHs) ? do
 
 ghcLinkArgs :: Args
 ghcLinkArgs = builder (Ghc LinkHs) ? do
-    stage   <- getStage
     way     <- getWay
     pkg     <- getPackage
     way     <- getWay
     pkg     <- getPackage
-    libs    <- getPkgDataList DepExtraLibs
-    libDirs <- getPkgDataList DepLibDirs
+    libs    <- pkg == hp2ps ? pure ["m"]
     intLib  <- getIntegerPackage
     intLib  <- getIntegerPackage
-    gmpLibs <- if stage > Stage0 && intLib == integerGmp
-               then do -- TODO: get this data more gracefully
-                   let strip = fromMaybe "" . stripPrefix "extra-libraries: "
-                   buildInfo <- expr $ readFileLines gmpBuildInfoPath
-                   return $ concatMap (words . strip) buildInfo
-               else return []
+    gmpLibs <- notStage0 ? intLib == integerGmp ? pure ["gmp"]
     mconcat [ (Dynamic `wayUnit` way) ?
               pure [ "-shared", "-dynamic", "-dynload", "deploy" ]
             , arg "-no-auto-link-packages"
             ,      nonHsMainPackage pkg  ? arg "-no-hs-main"
             , not (nonHsMainPackage pkg) ? arg "-rtsopts"
             , pure [ "-optl-l" ++           lib | lib <- libs ++ gmpLibs ]
     mconcat [ (Dynamic `wayUnit` way) ?
               pure [ "-shared", "-dynamic", "-dynload", "deploy" ]
             , arg "-no-auto-link-packages"
             ,      nonHsMainPackage pkg  ? arg "-no-hs-main"
             , not (nonHsMainPackage pkg) ? arg "-rtsopts"
             , pure [ "-optl-l" ++           lib | lib <- libs ++ gmpLibs ]
-            , pure [ "-optl-L" ++ unifyPath dir | dir <- libDirs ] ]
+            ]
 
 findHsDependencies :: Args
 findHsDependencies = builder (Ghc FindHsDependencies) ? do
 
 findHsDependencies :: Args
 findHsDependencies = builder (Ghc FindHsDependencies) ? do
@@ -71,27 +65,32 @@ findHsDependencies = builder (Ghc FindHsDependencies) ? do
             , getInputs ]
 
 haddockGhcArgs :: Args
             , getInputs ]
 
 haddockGhcArgs :: Args
-haddockGhcArgs = mconcat [ commonGhcArgs, getPkgDataList HsArgs ]
+haddockGhcArgs = mconcat [ commonGhcArgs, getPackageData PD.hcOpts ]
 
 -- Used in ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs and haddockGhcArgs.
 commonGhcArgs :: Args
 commonGhcArgs = do
 
 -- Used in ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs and haddockGhcArgs.
 commonGhcArgs :: Args
 commonGhcArgs = do
-    way  <- getWay
-    path <- getBuildPath
-    pkg  <- getPackage
-    when (pkg == rts) $ do
-        context <- getContext
-        conf <- expr $ pkgConfFile context
-        expr $ need [conf]
+    way     <- getWay
+    path    <- getBuildPath
+    pkg     <- getPackage
+    ghcVersion <- expr $ ghcVersionH
     mconcat [ arg "-hisuf", arg $ hisuf way
             , arg "-osuf" , arg $  osuf way
             , arg "-hcsuf", arg $ hcsuf way
             , wayGhcArgs
             , packageGhcArgs
             , includeGhcArgs
     mconcat [ arg "-hisuf", arg $ hisuf way
             , arg "-osuf" , arg $  osuf way
             , arg "-hcsuf", arg $ hcsuf way
             , wayGhcArgs
             , packageGhcArgs
             , includeGhcArgs
+            -- when compiling the rts for stage1 or stage2
+            -- we do not have the rts in the package db at
+            -- the time of builind it.  As such we need to
+            -- explicity supply the path to the ghc-version
+            -- file, to prevent ghc from trying to open the
+            -- rts package from the package db, and failing
+            -- over while doing so.
+            , (pkg == rts) ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion)
             , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
             , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
             , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
             , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
-            , map ("-optP" ++) <$> getPkgDataList CppArgs
+            , map ("-optP" ++) <$> getPackageData PD.cppOpts
             , arg "-odir"    , arg path
             , arg "-hidir"   , arg path
             , arg "-stubdir" , arg path ]
             , arg "-odir"    , arg path
             , arg "-hidir"   , arg path
             , arg "-stubdir" , arg path ]
@@ -111,13 +110,13 @@ wayGhcArgs = do
               pure ["-ticky", "-DTICKY_TICKY"] ]
 
 packageGhcArgs :: Args
               pure ["-ticky", "-DTICKY_TICKY"] ]
 
 packageGhcArgs :: Args
-packageGhcArgs = withHsPackage $ \cabalFile -> do
-    pkgId <- expr $ pkgIdentifier cabalFile
+packageGhcArgs = withHsPackage $ \ctx -> do
+    pkgId <- expr $ pkgIdentifier ctx
     mconcat [ arg "-hide-all-packages"
             , arg "-no-user-package-db"
     mconcat [ arg "-hide-all-packages"
             , arg "-no-user-package-db"
-            , bootPackageDatabaseArgs
+            , packageDatabaseArgs
             , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
             , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
-            , map ("-package-id " ++) <$> getPkgDataList DepIds ]
+            , map ("-package-id " ++) <$> getPackageData PD.depIpIds ]
 
 includeGhcArgs :: Args
 includeGhcArgs = do
 
 includeGhcArgs :: Args
 includeGhcArgs = do
@@ -125,7 +124,7 @@ includeGhcArgs = do
     path    <- getBuildPath
     root    <- getBuildRoot
     context <- getContext
     path    <- getBuildPath
     root    <- getBuildRoot
     context <- getContext
-    srcDirs <- getPkgDataList SrcDirs
+    srcDirs <- getPackageData PD.srcDirs
     autogen <- expr $ autogenPath context
     mconcat [ arg "-i"
             , arg $ "-i" ++ path
     autogen <- expr $ autogenPath context
     mconcat [ arg "-i"
             , arg $ "-i" ++ path
index 78b4587..4ed06d6 100644 (file)
@@ -2,37 +2,60 @@ module Settings.Builders.GhcCabal (
     ghcCabalBuilderArgs
     ) where
 
     ghcCabalBuilderArgs
     ) where
 
-import Hadrian.Haskell.Cabal
+import Data.Maybe (fromJust)
 
 
+import Builder ( ArMode ( Pack ) )
 import Context
 import Flavour
 import Context
 import Flavour
+import GHC.Packages
+import Hadrian.Builder (getBuilderPath, needBuilder )
+import Hadrian.Haskell.Cabal
 import Settings.Builders.Common
 
 ghcCabalBuilderArgs :: Args
 import Settings.Builders.Common
 
 ghcCabalBuilderArgs :: Args
-ghcCabalBuilderArgs = builder GhcCabal ? do
+ghcCabalBuilderArgs = mconcat
+  [ builder (GhcCabal Conf) ? do
     verbosity <- expr getVerbosity
     top       <- expr topDirectory
     verbosity <- expr getVerbosity
     top       <- expr topDirectory
-    path      <- getBuildPath
-    notStage0 ? expr (need inplaceLibCopyTargets)
+    path      <- getContextPath
+    stage     <- getStage
     mconcat [ arg "configure"
     mconcat [ arg "configure"
-            , arg =<< pkgPath <$> getPackage
+            -- don't strip libraries when cross compiling.
+            -- XXX we need to set --with-strip= (stripCmdPath :: Action FilePath), and if it's ':' disable
+            --     stripping as well. As it is now, I believe we might have issues with stripping on
+            --     windows, as I can't see a consumre of `stripCmdPath`.
+            , crossCompiling ? pure [ "--disable-executable-stripping", "--disable-library-stripping" ]
+            , arg "--cabal-file"
+            , arg =<< fromJust . pkgCabalFile <$> getPackage
+            , arg "--distdir"
             , arg $ top -/- path
             , arg $ top -/- path
+            , arg "--ipid"
+            , arg "$pkg-$version"
+            , arg "--prefix"
+            , arg "${pkgroot}/.."
             , withStaged $ Ghc CompileHs
             , withStaged (GhcPkg Update)
             , withStaged $ Ghc CompileHs
             , withStaged (GhcPkg Update)
+            , withBuilderArgs (GhcPkg Update stage)
             , bootPackageDatabaseArgs
             , libraryArgs
             , configureArgs
             , bootPackageConstraints
             , withStaged $ Cc CompileC
             , bootPackageDatabaseArgs
             , libraryArgs
             , configureArgs
             , bootPackageConstraints
             , withStaged $ Cc CompileC
-            , notStage0 ? with Ld
+            , notStage0 ? with (Ld stage)
             , withStaged (Ar Pack)
             , with Alex
             , with Happy
             , withStaged (Ar Pack)
             , with Alex
             , with Happy
-            , verbosity < Chatty ? pure [ "-v0", "--configure-option=--quiet"
-                , "--configure-option=--disable-option-checking"  ] ]
+            , verbosity < Chatty ?
+              pure [ "-v0", "--configure-option=--quiet"
+                   , "--configure-option=--disable-option-checking"
+                   ]
+            ]
+  ]
+
 
 -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
 -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
 
 -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
 -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
+-- TODO: should `elem` be `wayUnit`?
 libraryArgs :: Args
 libraryArgs = do
     ways        <- getLibraryWays
 libraryArgs :: Args
 libraryArgs = do
     ways        <- getLibraryWays
@@ -81,14 +104,16 @@ configureArgs = do
         , conf "--with-gmp-libraries"     $ arg =<< getSetting GmpLibDir
         , conf "--with-curses-libraries"  $ arg =<< getSetting CursesLibDir
         , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull)
         , conf "--with-gmp-libraries"     $ arg =<< getSetting GmpLibDir
         , conf "--with-curses-libraries"  $ arg =<< getSetting CursesLibDir
         , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull)
-        , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage ]
+        , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage
+        , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))]
 
 bootPackageConstraints :: Args
 bootPackageConstraints = stage0 ? do
     bootPkgs <- expr $ stagePackages Stage0
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
 
 bootPackageConstraints :: Args
 bootPackageConstraints = stage0 ? do
     bootPkgs <- expr $ stagePackages Stage0
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
+    ctx <- getContext
     constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do
     constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do
-        version <- traverse pkgVersion (pkgCabalFile pkg)
+        version <- pkgVersion (ctx { Context.package = pkg})
         return $ fmap ((pkgName pkg ++ " == ") ++) version
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
         return $ fmap ((pkgName pkg ++ " == ") ++) version
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
@@ -100,7 +125,7 @@ cppArgs = do
 withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
     Ar _ _     -> "--with-ar="
 withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
     Ar _ _     -> "--with-ar="
-    Ld         -> "--with-ld="
+    Ld _       -> "--with-ld="
     Cc  _ _    -> "--with-gcc="
     Ghc _ _    -> "--with-ghc="
     Alex       -> "--with-alex="
     Cc  _ _    -> "--with-gcc="
     Ghc _ _    -> "--with-ghc="
     Alex       -> "--with-alex="
@@ -108,6 +133,16 @@ withBuilderKey b = case b of
     GhcPkg _ _ -> "--with-ghc-pkg="
     _          -> error $ "withBuilderKey: not supported builder " ++ show b
 
     GhcPkg _ _ -> "--with-ghc-pkg="
     _          -> error $ "withBuilderKey: not supported builder " ++ show b
 
+-- Adds arguments to builders if needed.
+withBuilderArgs :: Builder -> Args
+withBuilderArgs b = case b of
+    GhcPkg _ stage -> do
+      top   <- expr topDirectory
+      pkgDb <- expr $ packageDbPath stage
+      notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb)
+    _          -> return [] -- no arguments
+
+
 -- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
 with :: Builder -> Args
 with b = do
 -- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
 with :: Builder -> Args
 with b = do
@@ -120,3 +155,12 @@ with b = do
 withStaged :: (Stage -> Builder) -> Args
 withStaged sb = with . sb =<< getStage
 
 withStaged :: (Stage -> Builder) -> Args
 withStaged sb = with . sb =<< getStage
 
+stagedBuilderPath :: (Stage -> Builder) -> Args
+stagedBuilderPath sb = builderPath . sb =<< getStage
+  where builderPath :: Builder -> Args
+        builderPath b = do
+          path <- getBuilderPath b
+          if (null path) then mempty else do
+            top <- expr topDirectory
+            expr $ needBuilder b
+            arg $ unifyPath (top </> path)
index ba705c6..4056d84 100644 (file)
@@ -5,12 +5,24 @@ import Settings.Builders.Common
 ghcPkgBuilderArgs :: Args
 ghcPkgBuilderArgs = mconcat
     [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ]
 ghcPkgBuilderArgs :: Args
 ghcPkgBuilderArgs = mconcat
     [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ]
-
+    , builder (GhcPkg Clone) ? do
+        verbosity <- expr getVerbosity
+        stage     <- getStage
+        pkgDb     <- expr $ packageDbPath stage
+        mconcat [ arg "--global-package-db"
+                , arg pkgDb
+                , arg "register"
+                , verbosity < Chatty ? arg "-v0"
+                ]
     , builder (GhcPkg Update) ? do
         verbosity <- expr getVerbosity
         context   <- getContext
         config    <- expr $ pkgInplaceConfig context
     , builder (GhcPkg Update) ? do
         verbosity <- expr getVerbosity
         context   <- getContext
         config    <- expr $ pkgInplaceConfig context
-        mconcat [ arg "update"
+        stage     <- getStage
+        pkgDb     <- expr $ packageDbPath stage
+        mconcat [ notStage0 ? arg "--global-package-db"
+                , notStage0 ? arg pkgDb
+                , arg "update"
                 , arg "--force"
                 , verbosity < Chatty ? arg "-v0"
                 , bootPackageDatabaseArgs
                 , arg "--force"
                 , verbosity < Chatty ? arg "-v0"
                 , bootPackageDatabaseArgs
index ed29012..2486569 100644 (file)
@@ -1,25 +1,26 @@
 module Settings.Builders.Haddock (haddockBuilderArgs) where
 
 module Settings.Builders.Haddock (haddockBuilderArgs) where
 
-import Hadrian.Utilities
 import Hadrian.Haskell.Cabal
 import Hadrian.Haskell.Cabal
-
+import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Utilities
 import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
 
 -- | Given a version string such as "2.16.2" produce an integer equivalent.
 versionToInt :: String -> Int
 import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
 
 -- | Given a version string such as "2.16.2" produce an integer equivalent.
 versionToInt :: String -> Int
-versionToInt s = case map read . words $ replaceEq '.' ' ' s of
-    [major, minor, patch] -> major * 1000 + minor * 10 + patch
-    _                     -> error "versionToInt: cannot parse version."
+versionToInt = read . dropWhile (=='0') . filter (/='.')
 
 haddockBuilderArgs :: Args
 
 haddockBuilderArgs :: Args
-haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat
+haddockBuilderArgs = withHsPackage $ \ctx -> mconcat
     [ builder (Haddock BuildIndex) ? do
         output <- getOutput
         inputs <- getInputs
     [ builder (Haddock BuildIndex) ? do
         output <- getOutput
         inputs <- getInputs
+        root   <- getBuildRoot
         mconcat
         mconcat
-            [ arg "--gen-index"
+            [ arg $ "-B" ++ root -/- "stage1" -/- "lib"
+            , arg $ "--lib=" ++ root -/- "docs"
+            , arg "--gen-index"
             , arg "--gen-contents"
             , arg "-o", arg $ takeDirectory output
             , arg "-t", arg "Haskell Hierarchical Libraries"
             , arg "--gen-contents"
             , arg "-o", arg $ takeDirectory output
             , arg "-t", arg "Haskell Hierarchical Libraries"
@@ -31,15 +32,18 @@ haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat
     , builder (Haddock BuildPackage) ? do
         output   <- getOutput
         pkg      <- getPackage
     , builder (Haddock BuildPackage) ? do
         output   <- getOutput
         pkg      <- getPackage
+        root     <- getBuildRoot
         path     <- getBuildPath
         path     <- getBuildPath
-        version  <- expr $ pkgVersion  cabalFile
-        synopsis <- expr $ pkgSynopsis cabalFile
-        deps     <- getPkgDataList DepNames
+        Just version  <- expr $ pkgVersion  ctx
+        Just synopsis <- expr $ pkgSynopsis ctx
+        deps     <- getPackageData PD.depNames
         haddocks <- expr . haddockDependencies =<< getContext
         haddocks <- expr . haddockDependencies =<< getContext
-        hVersion <- expr $ pkgVersion (unsafePkgCabalFile haddock) -- TODO: improve
+        Just hVersion <- expr $ pkgVersion ctx
         ghcOpts  <- haddockGhcArgs
         mconcat
             [ arg "--verbosity=0"
         ghcOpts  <- haddockGhcArgs
         mconcat
             [ arg "--verbosity=0"
+            , arg $ "-B" ++ root -/- "stage1" -/- "lib"
+            , arg $ "--lib=" ++ root -/- "docs"
             , arg $ "--odir=" ++ takeDirectory output
             , arg "--no-tmp-comp-dir"
             , arg $ "--dump-interface=" ++ output
             , arg $ "--odir=" ++ takeDirectory output
             , arg "--no-tmp-comp-dir"
             , arg $ "--dump-interface=" ++ output
@@ -49,14 +53,14 @@ haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat
             , arg "--quickjump"
             , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version
                     ++ ": " ++ synopsis
             , arg "--quickjump"
             , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version
                     ++ ": " ++ synopsis
-            , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt"
+            , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt"
             , arg $ "--optghc=-D__HADDOCK_VERSION__="
                     ++ show (versionToInt hVersion)
             , arg $ "--optghc=-D__HADDOCK_VERSION__="
                     ++ show (versionToInt hVersion)
-            , map ("--hide=" ++) <$> getPkgDataList HiddenModules
+            , map ("--hide=" ++) <$> getPackageData PD.otherModules
             , pure [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME},"
                      ++ haddock | (dep, haddock) <- zip deps haddocks ]
             , pure [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME},"
                      ++ haddock | (dep, haddock) <- zip deps haddocks ]
-            , pure [ "--optghc=" ++ opt | opt <- ghcOpts ]
+            , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ]
             , getInputs
             , arg "+RTS"
             , arg $ "-t" ++ path -/- "haddock.t"
             , getInputs
             , arg "+RTS"
             , arg $ "-t" ++ path -/- "haddock.t"
index aeb5255..54b6faf 100644 (file)
@@ -1,5 +1,6 @@
 module Settings.Builders.HsCpp (hsCppBuilderArgs) where
 
 module Settings.Builders.HsCpp (hsCppBuilderArgs) where
 
+import GHC.Packages
 import Settings.Builders.Common
 
 hsCppBuilderArgs :: Args
 import Settings.Builders.Common
 
 hsCppBuilderArgs :: Args
index 80e80db..3a80940 100644 (file)
@@ -1,5 +1,9 @@
 module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where
 
 module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where
 
+import Builder ()
+import GHC (autogenPath)
+import Hadrian.Builder (getBuilderPath)
+import Hadrian.Haskell.Cabal.PackageData as PD
 import Settings.Builders.Common
 
 hsc2hsBuilderArgs :: Args
 import Settings.Builders.Common
 
 hsc2hsBuilderArgs :: Args
@@ -15,9 +19,10 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
     version <- if stage == Stage0
                then expr ghcCanonVersion
                else getSetting ProjectVersionInt
     version <- if stage == Stage0
                then expr ghcCanonVersion
                else getSetting ProjectVersionInt
+    tmpl <- (top -/-) <$> expr (templateHscPath Stage0)
     mconcat [ arg $ "--cc=" ++ ccPath
             , arg $ "--ld=" ++ ccPath
     mconcat [ arg $ "--cc=" ++ ccPath
             , arg $ "--ld=" ++ ccPath
-            , notM windowsHost ? arg "--cross-safe"
+            , notM windowsHost ? notM crossCompiling ? arg "--cross-safe"
             , pure $ map ("-I" ++) (words gmpDir)
             , map ("--cflag=" ++) <$> getCFlags
             , map ("--lflag=" ++) <$> getLFlags
             , pure $ map ("-I" ++) (words gmpDir)
             , map ("--cflag=" ++) <$> getCFlags
             , map ("--lflag=" ++) <$> getLFlags
@@ -27,7 +32,7 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
             , notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1")
             , notStage0 ? arg ("--cflag=-D" ++ tOs   ++ "_HOST_OS=1"  )
             , arg $ "--cflag=-D__GLASGOW_HASKELL__=" ++ version
             , notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1")
             , notStage0 ? arg ("--cflag=-D" ++ tOs   ++ "_HOST_OS=1"  )
             , arg $ "--cflag=-D__GLASGOW_HASKELL__=" ++ version
-            , arg $ "--template=" ++ top -/- templateHscPath
+            , arg $ "--template=" ++ tmpl
             , arg =<< getInput
             , arg "-o", arg =<< getOutput ]
 
             , arg =<< getInput
             , arg "-o", arg =<< getOutput ]
 
@@ -38,18 +43,16 @@ getCFlags = do
     mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
             , getStagedSettingList ConfCppArgs
             , cIncludeArgs
     mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
             , getStagedSettingList ConfCppArgs
             , cIncludeArgs
-            , getPkgDataList CppArgs
-            , getPkgDataList DepCcArgs
+            , getPackageData PD.ccOpts
+            -- we might be able to leave out cppOpts, to be investigated.
+            , getPackageData PD.cppOpts
+            , getPackageData PD.depCcOpts
             , cWarnings
             , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
 
 getLFlags :: Expr [String]
             , cWarnings
             , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
 
 getLFlags :: Expr [String]
-getLFlags = do
-    libDirs   <- getPkgDataList DepLibDirs
-    extraLibs <- getPkgDataList DepExtraLibs
+getLFlags =
     mconcat [ getStagedSettingList ConfGccLinkerArgs
             , ldArgs
     mconcat [ getStagedSettingList ConfGccLinkerArgs
             , ldArgs
-            , getPkgDataList LdArgs
-            , pure [ "-L" ++ unifyPath dir | dir <- libDirs ]
-            , pure [ "-l" ++ unifyPath dir | dir <- extraLibs ]
-            , getPkgDataList DepLdArgs ]
+            , getPackageData PD.ldOpts
+            , getPackageData PD.depLdOpts ]
index c348bf1..24ee9c9 100644 (file)
@@ -1,9 +1,10 @@
 module Settings.Builders.RunTest (runTestBuilderArgs) where
 
 module Settings.Builders.RunTest (runTestBuilderArgs) where
 
-import Hadrian.Utilities
-
 import CommandLine (TestArgs(..), defaultTestArgs)
 import Flavour
 import CommandLine (TestArgs(..), defaultTestArgs)
 import Flavour
+import GHC.Packages
+import Hadrian.Builder (getBuilderPath)
+import Hadrian.Utilities
 import Rules.Test
 import Settings.Builders.Common
 
 import Rules.Test
 import Settings.Builders.Common
 
index 5658d00..5ef0cc3 100644 (file)
@@ -4,15 +4,10 @@ module Settings.Default (
     defaultFlavour, defaultSplitObjects
     ) where
 
     defaultFlavour, defaultSplitObjects
     ) where
 
-import qualified Hadrian.Builder.Ar
-import qualified Hadrian.Builder.Sphinx
-import qualified Hadrian.Builder.Tar
-
 import CommandLine
 import Expression
 import Flavour
 import Oracles.Flag
 import CommandLine
 import Expression
 import Flavour
 import Oracles.Flag
-import Oracles.PackageData
 import Settings
 import Settings.Builders.Alex
 import Settings.Builders.DeriveConstants
 import Settings
 import Settings.Builders.Alex
 import Settings.Builders.DeriveConstants
@@ -30,21 +25,18 @@ import Settings.Builders.Ld
 import Settings.Builders.Make
 import Settings.Builders.RunTest
 import Settings.Builders.Xelatex
 import Settings.Builders.Make
 import Settings.Builders.RunTest
 import Settings.Builders.Xelatex
-import Settings.Packages.Base
-import Settings.Packages.Cabal
-import Settings.Packages.Compiler
-import Settings.Packages.Ghc
-import Settings.Packages.GhcCabal
-import Settings.Packages.Ghci
-import Settings.Packages.GhcPkg
-import Settings.Packages.GhcPrim
-import Settings.Packages.Haddock
-import Settings.Packages.Haskeline
-import Settings.Packages.IntegerGmp
+import Settings.Packages
 import Settings.Packages.Rts
 import Settings.Packages.Rts
-import Settings.Packages.RunGhc
 import Settings.Warnings
 
 import Settings.Warnings
 
+import {-# SOURCE #-} Builder
+import GHC
+import GHC.Packages
+import qualified Hadrian.Builder.Ar
+import qualified Hadrian.Builder.Sphinx
+import qualified Hadrian.Builder.Tar
+import Hadrian.Haskell.Cabal.PackageData as PD
+
 -- TODO: Move C source arguments here
 -- | Default and package-specific source arguments.
 data SourceArgs = SourceArgs
 -- TODO: Move C source arguments here
 -- | Default and package-specific source arguments.
 data SourceArgs = SourceArgs
@@ -57,7 +49,7 @@ data SourceArgs = SourceArgs
 sourceArgs :: SourceArgs -> Args
 sourceArgs SourceArgs {..} = builder Ghc ? mconcat
     [ hsDefault
 sourceArgs :: SourceArgs -> Args
 sourceArgs SourceArgs {..} = builder Ghc ? mconcat
     [ hsDefault
-    , getPkgDataList HsArgs
+    , getPackageData PD.hcOpts
     , libraryPackage   ? hsLibrary
     , package compiler ? hsCompiler
     , package ghc      ? hsGhc ]
     , libraryPackage   ? hsLibrary
     , package compiler ? hsCompiler
     , package ghc      ? hsGhc ]
@@ -87,7 +79,8 @@ defaultLibraryWays :: Ways
 defaultLibraryWays = mconcat
     [ pure [vanilla]
     , notStage0 ? pure [profiling]
 defaultLibraryWays = mconcat
     [ pure [vanilla]
     , notStage0 ? pure [profiling]
-    , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]
+    -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
+    ]
 
 -- | Default build ways for the RTS.
 defaultRtsWays :: Ways
 
 -- | Default build ways for the RTS.
 defaultRtsWays :: Ways
@@ -96,9 +89,10 @@ defaultRtsWays = do
     mconcat
         [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ]
         , (profiling `elem` ways) ? pure [threadedProfiling]
     mconcat
         [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ]
         , (profiling `elem` ways) ? pure [threadedProfiling]
-        , (dynamic `elem` ways) ?
+        {- , (dynamic `elem` ways) ?
           pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic
           pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic
-                 , loggingDynamic, threadedLoggingDynamic ] ]
+               , loggingDynamic, threadedLoggingDynamic ] -}
+        ]
 
 -- Please update doc/flavours.md when changing the default build flavour.
 -- | Default build flavour. Other build flavours are defined in modules
 
 -- Please update doc/flavours.md when changing the default build flavour.
 -- | Default build flavour. Other build flavours are defined in modules
@@ -159,17 +153,6 @@ defaultBuilderArgs = mconcat
 -- | All 'Package'-dependent command line arguments.
 defaultPackageArgs :: Args
 defaultPackageArgs = mconcat
 -- | All 'Package'-dependent command line arguments.
 defaultPackageArgs :: Args
 defaultPackageArgs = mconcat
-    [ basePackageArgs
-    , cabalPackageArgs
-    , compilerPackageArgs
-    , ghcCabalPackageArgs
-    , ghciPackageArgs
-    , ghcPackageArgs
-    , ghcPkgPackageArgs
-    , ghcPrimPackageArgs
-    , haddockPackageArgs
-    , haskelinePackageArgs
-    , integerGmpPackageArgs
+    [ packageArgs
     , rtsPackageArgs
     , rtsPackageArgs
-    , runGhcPackageArgs
     , warningArgs ]
     , warningArgs ]
index a9dfb70..836b935 100644 (file)
@@ -19,5 +19,10 @@ quickestArgs = sourceArgs SourceArgs
     , hsCompiler = stage0 ? arg "-O"
     , hsGhc      = stage0 ? arg "-O" }
 
     , hsCompiler = stage0 ? arg "-O"
     , hsGhc      = stage0 ? arg "-O" }
 
+-- Replicate GHCs RtsWays for flavour quickest (without dynamic):
+-- $ make show! VALUE=GhcLibWays
+-- GhcLibWays="v"
+-- $ make show! VALUE=GhcRTSWays
+-- GhcRTSWays="l debug thr thr_debug thr_l"
 quickestRtsWays :: Ways
 quickestRtsWays :: Ways
-quickestRtsWays = pure [vanilla, threaded]
+quickestRtsWays = pure [vanilla, logging, debug, threaded, threadedDebug, threadedLogging]
diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs
new file mode 100644 (file)
index 0000000..91adc61
--- /dev/null
@@ -0,0 +1,125 @@
+module Settings.Packages (packageArgs) where
+
+import Expression
+import Flavour
+import GHC.Packages
+import Oracles.Setting
+import Oracles.Flag
+import Rules.Gmp
+import Settings
+
+packageArgs :: Args
+packageArgs = do
+  intLibPkg <- getIntegerPackage
+  integerLibraryName <- pkgName <$> getIntegerPackage
+
+  stage   <- getStage
+  rtsWays <- getRtsWays
+  path    <- getBuildPath
+
+  compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler)
+
+  gmpBuildPath <- expr gmpBuildPath
+  let includeGmp = "-I" ++ gmpBuildPath -/- "include"
+
+  version <- getSetting ProjectVersion
+
+  mconcat
+    [ package base
+      ? mconcat [ builder CabalFlags ? arg ('+':integerLibraryName)
+                  -- This fixes the 'unknown symbol stat' issue.
+                  -- See: https://github.com/snowleopard/hadrian/issues/259.
+                , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
+    , package bytestring
+      ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple"
+    , package text
+      -- text is rather tricky. It's a boot lib, and it tries to determine on
+      -- it's own if it should link against integer-gmp or integer-simple.
+      -- For stage0, we need to use the integer library that the bootstrap
+      -- compiler has. (the interger-lib is not a boot lib) but as such, we'll
+      -- copy it over into the stage0 package-db (maybe we should stop doing this?)
+      -- And subsequently text for stage1 will detect the same integer lib again,
+      -- even though we don't build it in stage1, and at that point the
+      -- configuration is just wrong.
+      ? builder CabalFlags ? notStage0 ? intLibPkg == integerSimple ? pure [ "+integer-simple"
+                                                                           , "-bytestring-builder"]
+    , package cabal
+      -- Cabal is a rather large library and quite slow to compile. Moreover, we
+      -- build it for stage0 only so we can link ghc-pkg against it, so there is
+      -- little reason to spend the effort to optimize it.
+      ? stage0 ? builder Ghc ? arg "-O0"
+    , package compiler
+      ? mconcat [ builder Alex ? arg "--latin1"
+                , builder (Ghc CompileHs) ? mconcat
+                  [ inputs ["//GHC.hs", "//GhcMake.hs"] ? arg "-fprof-auto"
+                  , input "//Parser.hs" ?
+                    pure ["-O0", "-fno-ignore-interface-pragmas", "-fcmm-sink" ] ]
+                , builder (GhcCabal Conf) ? mconcat
+                  [ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1)
+                  , arg "--disable-library-for-ghci"
+                  , anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
+                  , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
+                  , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP"
+                  , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
+                  , (any (wayUnit Threaded) rtsWays) ?
+                    notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
+                  , ghcWithInterpreter ?
+                    ghcEnableTablesNextToCode ?
+                    notM (flag GhcUnregisterised) ?
+                    notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
+                  , ghcWithInterpreter ?
+                    ghciWithDebugger <$> flavour ?
+                    notStage0 ? arg "--ghc-option=-DDEBUGGER"
+                  , ghcProfiled <$> flavour ?
+                    notStage0 ? arg "--ghc-pkg-option=--force" ]
+                , builder CabalFlags ? mconcat
+                  [ ghcWithNativeCodeGen ? arg "ncg"
+                  , ghcWithInterpreter ?
+                    notStage0 ? arg "ghci"
+                  , crossCompiling ? arg "-terminfo"
+                  ]
+                , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
+    , package ghc
+      ? mconcat [ builder Ghc        ? arg ("-I" ++ compilerBuildPath)
+                , builder CabalFlags ? ghcWithInterpreter ? notStage0 ? arg "ghci"
+                , builder CabalFlags ? crossCompiling ? arg "-terminfo" ]
+    , package ghcPkg
+      ? builder CabalFlags ? crossCompiling ? arg "-terminfo"
+    , package ghcPrim
+      ? mconcat [ builder CabalFlags ? arg "include-ghc-prim"
+                , builder (Cc CompileC)     ?
+                  (not <$> flag GccIsClang) ?
+                  input "//cbits/atomic.c"  ? arg "-Wno-sync-nand" ]
+      -- XXX: This should not be *not <$> crossCompiling*, but ensure
+      --      that the bootstrap compiler has the same version as the
+      --      one we are building.
+      -- XXX: In that case we also do not need to build most of the
+      --      stage1 libraries, as we already know that the compiler
+      --      comes with the most recent versions.
+      -- XXX: The use case here is that we want to build ghc-proxy for
+      --      the cross compiler. That one needs to be compiled by the
+      --      bootstrap compiler as it needs to run on the host. and as
+      --      such libiserv needs GHCi.TH, GHCi.Message and GHCi.Run from
+      --      ghci. And those are beind the -fghci flag.
+    , package ghci ? notStage0 ? builder CabalFlags ? arg "ghci"
+    , package ghci ? crossCompiling ? stage0 ? builder CabalFlags ? arg "ghci"
+    , package haddock ? builder CabalFlags ? arg "in-ghc-tree"
+    , package haskeline ? builder CabalFlags ? crossCompiling ? arg "-terminfo"
+    , package hsc2hs ? builder CabalFlags ? arg "in-ghc-tree"
+    , package integerGmp
+      ? mconcat [ builder Cc ? arg includeGmp
+                , builder (GhcCabal Conf) ? mconcat
+                  [ -- (null gmpIncludeDir && null gmpLibDir) ?
+                    -- XXX: this should respect some settings flag "InTreeGmp".
+                    --      depending on include and lib dir, is bound to fail
+                    --      these are only set if ./configure was explicilty
+                    --      called with gmp include and lib dirs.  Their absense
+                    --      as such does not imply in-tree-gmp
+                    -- arg "--configure-option=--with-intree-gmp"
+                    arg ("--configure-option=CFLAGS=" ++ includeGmp)
+                  , arg ("--gcc-options="             ++ includeGmp) ] ]
+    , package runGhc
+      ? builder Ghc ? input "//Main.hs" ? pure ["-cpp", "-DVERSION=" ++ show version]
+    , package rts
+      ? builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling"
+    ]
diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs
deleted file mode 100644 (file)
index 254c6b7..0000000
+++ /dev/null
@@ -1,8 +0,0 @@
-module Settings.Packages.Haskeline (haskelinePackageArgs) where
-
-import Expression
-import Oracles.Flag (crossCompiling)
-
-haskelinePackageArgs :: Args
-haskelinePackageArgs =
-    package haskeline ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo"
index fcbd795..da17f17 100644 (file)
@@ -4,6 +4,7 @@ module Settings.Packages.Rts (
 
 import Base
 import Expression
 
 import Base
 import Expression
+import GHC.Packages
 import Oracles.Flag
 import Oracles.Setting
 import Settings
 import Oracles.Flag
 import Oracles.Setting
 import Settings
index 19a12df..2e3c50b 100644 (file)
@@ -1,6 +1,7 @@
 module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where
 
 import Expression
 module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where
 
 import Expression
+import GHC.Packages
 import Oracles.Flag
 import Oracles.Setting
 import Settings
 import Oracles.Flag
 import Oracles.Setting
 import Settings
index a1a82dc..e52ed68 100644 (file)
@@ -3,12 +3,10 @@
 -- If you don't copy the file your changes will be tracked by git and you can
 -- accidentally commit them.
 module UserSettings (
 -- If you don't copy the file your changes will be tracked by git and you can
 -- accidentally commit them.
 module UserSettings (
-    userBuildRoot, userFlavours, userPackages, verboseCommand,
+    userFlavours, userPackages, verboseCommand,
     buildProgressColour, successColour, stage1Only
     ) where
 
     buildProgressColour, successColour, stage1Only
     ) where
 
-import Hadrian.Utilities
-
 import Flavour
 import Expression
 import {-# SOURCE #-} Settings.Default
 import Flavour
 import Expression
 import {-# SOURCE #-} Settings.Default
@@ -16,10 +14,6 @@ import {-# SOURCE #-} Settings.Default
 -- See doc/user-settings.md for instructions.
 -- Please update doc/user-settings.md when committing changes to this file.
 
 -- See doc/user-settings.md for instructions.
 -- Please update doc/user-settings.md when committing changes to this file.
 
--- | All build results are put into the 'buildRoot' directory.
-userBuildRoot :: BuildRoot
-userBuildRoot = BuildRoot "_build"
-
 -- | User-defined build flavours. See 'userFlavour' as an example.
 userFlavours :: [Flavour]
 userFlavours = [userFlavour] -- Add more build flavours if need be.
 -- | User-defined build flavours. See 'userFlavour' as an example.
 userFlavours :: [Flavour]
 userFlavours = [userFlavour] -- Add more build flavours if need be.
index fc898c3..57faf41 100644 (file)
@@ -1,19 +1,22 @@
 module Utilities (
 module Utilities (
-    build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith,
+    build, buildWithResources, buildWithCmdOptions,
+    askWithResources,
+    runBuilder, runBuilderWith,
     needLibrary, contextDependencies, stage1Dependencies, libraryTargets,
     needLibrary, contextDependencies, stage1Dependencies, libraryTargets,
-    topsortPackages
+    topsortPackages, cabalDependencies
     ) where
 
 import qualified Hadrian.Builder as H
 import Hadrian.Haskell.Cabal
     ) where
 
 import qualified Hadrian.Builder as H
 import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.PackageData as PD
 import Hadrian.Utilities
 
 import Context
 import Expression hiding (stage)
 import Hadrian.Utilities
 
 import Context
 import Expression hiding (stage)
-import Oracles.PackageData
+import GHC.Packages
+import Oracles.Setting (windowsHost)
 import Settings
 import Target
 import Settings
 import Target
-import UserSettings
 
 build :: Target -> Action ()
 build target = H.build target getArgs
 
 build :: Target -> Action ()
 build target = H.build target getArgs
@@ -24,6 +27,9 @@ buildWithResources rs target = H.buildWithResources rs target getArgs
 buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
 buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs
 
 buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
 buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs
 
+askWithResources :: [(Resource, Int)] -> Target -> Action String
+askWithResources rs target = H.askWithResources rs target getArgs
+
 -- TODO: Cache the computation.
 -- | Given a 'Context' this 'Action' looks up the package dependencies and wraps
 -- the results in appropriate contexts. The only subtlety here is that we never
 -- TODO: Cache the computation.
 -- | Given a 'Context' this 'Action' looks up the package dependencies and wraps
 -- the results in appropriate contexts. The only subtlety here is that we never
@@ -32,7 +38,7 @@ buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs
 -- dependencies we transitively scan @.cabal@ files using 'pkgDependencies'
 -- defined in "Hadrian.Haskell.Cabal".
 contextDependencies :: Context -> Action [Context]
 -- dependencies we transitively scan @.cabal@ files using 'pkgDependencies'
 -- defined in "Hadrian.Haskell.Cabal".
 contextDependencies :: Context -> Action [Context]
-contextDependencies Context {..} = do
+contextDependencies ctx@Context {..} = do
     depPkgs <- go [package]
     return [ Context depStage pkg way | pkg <- depPkgs, pkg /= package ]
   where
     depPkgs <- go [package]
     return [ Context depStage pkg way | pkg <- depPkgs, pkg /= package ]
   where
@@ -41,12 +47,15 @@ contextDependencies Context {..} = do
         deps <- concatMapM step pkgs
         let newPkgs = nubOrd $ sort (deps ++ pkgs)
         if pkgs == newPkgs then return pkgs else go newPkgs
         deps <- concatMapM step pkgs
         let newPkgs = nubOrd $ sort (deps ++ pkgs)
         if pkgs == newPkgs then return pkgs else go newPkgs
-    step pkg   = case pkgCabalFile pkg of
-        Nothing        -> return [] -- Non-Cabal packages have no dependencies.
-        Just cabalFile -> do
-            deps   <- pkgDependencies cabalFile
-            active <- sort <$> stagePackages depStage
-            return $ intersectOrd (compare . pkgName) active deps
+    step pkg = pkgDependencies (ctx { Context.package = pkg }) >>= \case
+      Nothing -> return [] -- Non-Cabal packages have no dependencies.
+      Just deps -> do
+        active <- sort <$> stagePackages depStage
+        return $ intersectOrd (compare . pkgName) active deps
+
+cabalDependencies :: Context -> Action [String]
+cabalDependencies ctx = interpretInContext ctx $
+  getPackageData PD.depIpIds
 
 -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
 stage1Dependencies :: Package -> Action [Package]
 
 -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
 stage1Dependencies :: Package -> Action [Package]
@@ -57,16 +66,19 @@ stage1Dependencies =
 -- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
 libraryTargets :: Bool -> Context -> Action [FilePath]
 libraryTargets includeGhciLib context = do
 -- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
 libraryTargets :: Bool -> Context -> Action [FilePath]
 libraryTargets includeGhciLib context = do
-    confFile <- pkgConfFile        context
     libFile  <- pkgLibraryFile     context
     lib0File <- pkgLibraryFile0    context
     lib0     <- buildDll0          context
     ghciLib  <- pkgGhciLibraryFile context
     libFile  <- pkgLibraryFile     context
     lib0File <- pkgLibraryFile0    context
     lib0     <- buildDll0          context
     ghciLib  <- pkgGhciLibraryFile context
-    ghciFlag <- if includeGhciLib
-                then interpretInContext context $ getPkgData BuildGhciLib
-                else return "NO"
-    let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only)
-    return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
+    ghci     <- if includeGhciLib
+                then interpretInContext context $ getPackageData PD.buildGhciLib
+                else return False
+    return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
+
+  where buildDll0 :: Context -> Action Bool
+        buildDll0 Context {..} = do
+          windows <- windowsHost
+          return $ windows && stage == Stage1 && package == compiler
 
 -- | Coarse-grain 'need': make sure all given libraries are fully built.
 needLibrary :: [Context] -> Action ()
 
 -- | Coarse-grain 'need': make sure all given libraries are fully built.
 needLibrary :: [Context] -> Action ()