WIP: Relocation based build (inplace free)

.gitmodules

@@ -0,0 +1,6 @@
+[submodule "shake"]
+	path = shake
+	url = https://github.com/ndmitchell/shake.git
+[submodule "happy"]
+	path = happy
+	url = https://github.com/simonmar/happy.git

cabal.project

@@ -3,3 +3,14 @@ packages: ./
           ../libraries/hpc/
           ../libraries/parsec/
           ../libraries/text/
+
+package hadrian
+  ghc-options: -Werror
+
+repository head.hackage
+   url: http://head.hackage.haskell.org/
+   secure: True
+   root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740
+              2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb
+              8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e
+   key-threshold: 3

hadrian.cabal

@@ -22,10 +22,11 @@ executable hadrian
                        , Builder
                        , CommandLine
                        , Context
+                       , Context.Paths
                        , Environment
                        , Expression
-                       , Flavour
                        , GHC
+                       , GHC.Packages
                        , Hadrian.Builder
                        , Hadrian.Builder.Ar
                        , Hadrian.Builder.Sphinx
@@ -85,22 +86,20 @@ executable hadrian
                        , Settings.Flavours.Profiled
                        , Settings.Flavours.Quick
                        , Settings.Flavours.QuickCross
+                       , Settings.Flavours.QuickCrossNG
                        , 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.RunGhc
                        , Settings.Warnings
                        , Stage
+                       , Types.Context
+                       , Types.Package
+                       , Types.Stage
+                       , Types.Cabal
+                       , Types.ConfiguredCabal
+                       , Types.Expression
+                       , Types.Flavour
+                       , Types.Way
                        , Target
                        , UserSettings
                        , Utilities

src/Base.hs

@@ -18,10 +18,13 @@ module Base (
     module Stage,
     module Way,
 
+    -- * Files
+    configH, ghcVersionH,
     -- * Paths
-    hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
-    generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
-    inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir,
+    hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
+    generatedDir, generatedPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
+    stageBinPath, stageLibPath,
+    ghcDeps, templateHscPath,
     inplacePackageDbPath, packageDbPath, packageDbStamp
     ) where
 
@@ -64,6 +67,9 @@ sourcePath = hadrianPath -/- "src"
 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
@@ -74,18 +80,16 @@ shakeFilesDir = "hadrian"
 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 = "inplace/lib/package.conf.d"
+-- | Path to the inplace package database.
+inplacePackageDbPath :: Stage -> FilePath
+inplacePackageDbPath stage = stageString stage -/- "lib" -/- "package.conf.d"
 
 -- | Path to the package database used in a given 'Stage'.
 packageDbPath :: Stage -> Action FilePath
-packageDbPath Stage0 = buildRoot <&> (-/- stage0PackageDbDir)
-packageDbPath _      = return inplacePackageDbPath
+packageDbPath stage  = buildRoot <&> (-/- inplacePackageDbPath stage)
 
 -- | We use a stamp file to track the existence of a package database.
 packageDbStamp :: FilePath
@@ -103,19 +107,21 @@ inplaceLibPath = "inplace/lib"
 inplaceLibBinPath :: FilePath
 inplaceLibBinPath = "inplace/lib/bin"
 
--- ref: ghc/ghc.mk:142
--- ref: driver/ghc.mk
--- ref: utils/hsc2hs/ghc.mk:35
--- | Files that need to be copied over to 'inplaceLibPath'.
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
-    [ "ghc-usage.txt"
-    , "ghci-usage.txt"
-    , "llvm-targets"
-    , "platformConstants"
-    , "settings"
-    , "template-hsc.h" ]
+stageBinPath :: Stage -> Action FilePath
+stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin")
+
+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" ]
 
 -- | Path to hsc2hs template.
-templateHscPath :: FilePath
-templateHscPath = "inplace/lib/template-hsc.h"
+templateHscPath :: Stage -> Action FilePath
+templateHscPath stage = stageLibPath stage <&> (-/- "/template-hsc.h")

src/Builder.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE InstanceSigs #-}
 module Builder (
     -- * Data types
-    ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
+    ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
     SphinxMode (..), TarMode (..), Builder (..),
 
+    builderPath',
+
     -- * Builder properties
     builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
     runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,
@@ -46,15 +48,23 @@ instance NFData   CcMode
 -- * Compile a C source file.
 -- * Extract source dependencies by passing @-M@ command line argument.
 -- * Link object files & static libraries into an executable.
-data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
+data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
     deriving (Eq, Generic, Show)
 
 instance Binary   GhcMode
 instance Hashable GhcMode
 instance NFData   GhcMode
 
+-- | GHC cabal mode. Can configure, copy and register pacakges.
+data GhcCabalMode = Conf | Copy | Reg | 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.
-data GhcPkgMode = Init | Update deriving (Eq, Generic, Show)
+data GhcPkgMode = Init | Update | Clone | Dependencies deriving (Eq, Generic, Show)
 
 instance Binary   GhcPkgMode
 instance Hashable GhcPkgMode
@@ -82,13 +92,13 @@ data Builder = Alex
              | GenApply
              | GenPrimopCode
              | Ghc GhcMode Stage
-             | GhcCabal
+             | GhcCabal GhcCabalMode Stage
              | GhcPkg GhcPkgMode Stage
              | Haddock HaddockMode
              | Happy
              | Hpc
              | HsCpp
-             | Hsc2Hs
+             | Hsc2Hs Stage
              | Ld
              | Make FilePath
              | Nm
@@ -100,6 +110,8 @@ data Builder = Alex
              | Tar TarMode
              | Unlit
              | Xelatex
+             | CabalFlags Stage -- ^ a virtual builder to use the Arg predicate logic
+                                --   to collect cabal flags. +x, -x
              deriving (Eq, Generic, Show)
 
 instance Binary   Builder
@@ -116,17 +128,20 @@ builderProvenance = \case
     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
-    Haddock _        -> context Stage2 haddock
-    Hpc              -> context Stage1 hpcBin
-    Hsc2Hs           -> context Stage0 hsc2hs
+    Haddock _        -> context Stage1 haddock
+    Hpc              -> context Stage0 hpcBin
+    Hsc2Hs _         -> context Stage0 hsc2hs
     Unlit            -> context Stage0 unlit
     _                -> Nothing
   where
     context s p = Just $ vanillaContext s p
 
+builderPath' :: Builder -> Action FilePath
+builderPath' = builderPath
+
 instance H.Builder Builder where
     builderPath :: Builder -> Action FilePath
     builderPath builder = case builderProvenance builder of
@@ -138,10 +153,35 @@ instance H.Builder Builder where
         path <- H.builderPath builder
         case builder of
             Configure dir -> need [dir -/- "configure"]
-            Hsc2Hs        -> need [path, templateHscPath]
+            Hsc2Hs stage  -> templateHscPath stage >>= \tmpl -> need [path, tmpl]
             Make dir      -> need [dir -/- "Makefile"]
             _             -> when (isJust $ builderProvenance builder) $ need [path]
 
+    -- TODO: We would need to encode that asking a builder,
+    --       depending on the "ask" mode, has different return types.
+    --       For now it's the stdout string.
+    --
+    --       This however means that the string -> datatype logic
+    --       needs to reside at the callsite.
+    askBuilderWith :: Builder -> BuildInfo -> Action String
+    askBuilderWith builder BuildInfo {..} = case builder of
+        Ghc Settings _ -> do
+            needBuilder builder
+            path <- H.builderPath builder
+            need [path]
+            Stdout stdout <- cmd [path] ["--info"]
+            return stdout
+
+        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
@@ -190,7 +230,12 @@ instance H.Builder Builder where
                     unit $ cmd [Cwd output] [path]        buildArgs
                     unit $ cmd [Cwd output] [path]        buildArgs
 
-                _  -> cmd echo [path] buildArgs
+                GhcPkg Clone _ -> do
+                    -- input is "virtual" here. it's essentially a package name
+                    Stdout pkgDesc <- cmd [path] ["--expand-pkgroot", "--no-user-package-db", "describe", input ]
+                    cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"])
+
+                _  -> cmd echo [path] buildOptions buildArgs
 
 -- TODO: Some builders are required only on certain platforms. For example,
 -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform

src/Builder.hs-boot

@@ -0,0 +1,44 @@
+module Builder where
+
+import Stage
+import Hadrian.Builder.Ar
+import Hadrian.Builder.Sphinx
+import Hadrian.Builder.Tar
+import Development.Shake
+
+data CcMode = CompileC | FindCDependencies
+data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
+data GhcCabalMode = Conf | Copy | Reg | 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
+             | HsCpp
+             | Hsc2Hs Stage
+             | Ld
+             | Make FilePath
+             | Nm
+             | Objdump
+             | Patch
+             | Perl
+             | Ranlib
+             | Sphinx SphinxMode
+             | Tar TarMode
+             | Unlit
+             | Xelatex
+             | CabalFlags Stage
+
+instance Eq Builder
+
+builderPath' :: Builder -> Action FilePath