summaryrefslogtreecommitdiff
path: root/hadrian/src
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-12-08 12:42:35 -0500
committerBen Gamari <ben@smart-cactus.org>2017-12-08 13:22:41 -0500
commit7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3 (patch)
tree79c5e7151d760e6c7617d8450fb9ec2a10560989 /hadrian/src
parent5695f462f604fc63cbb45a7f3073bc114f9b475f (diff)
downloadhaskell-7733e44dd4ba7e7a0a9f3456e6ddc32decbcf5a3.tar.gz
Rip out hadrian subtree
Sadly subtrees haven't worked quite as well as we would have liked for developers. See Hadrian #440.
Diffstat (limited to 'hadrian/src')
-rw-r--r--hadrian/src/Base.hs121
-rw-r--r--hadrian/src/Builder.hs296
-rw-r--r--hadrian/src/CommandLine.hs137
-rw-r--r--hadrian/src/Context.hs158
-rw-r--r--hadrian/src/Environment.hs16
-rw-r--r--hadrian/src/Expression.hs123
-rw-r--r--hadrian/src/Flavour.hs34
-rw-r--r--hadrian/src/GHC.hs289
-rw-r--r--hadrian/src/Hadrian/Builder.hs125
-rw-r--r--hadrian/src/Hadrian/Builder/Ar.hs68
-rw-r--r--hadrian/src/Hadrian/Builder/Sphinx.hs39
-rw-r--r--hadrian/src/Hadrian/Builder/Tar.hs40
-rw-r--r--hadrian/src/Hadrian/Expression.hs153
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal.hs44
-rw-r--r--hadrian/src/Hadrian/Haskell/Cabal/Parse.hs63
-rw-r--r--hadrian/src/Hadrian/Oracles/ArgsHash.hs51
-rw-r--r--hadrian/src/Hadrian/Oracles/DirectoryContents.hs64
-rw-r--r--hadrian/src/Hadrian/Oracles/Path.hs62
-rw-r--r--hadrian/src/Hadrian/Oracles/TextFile.hs123
-rw-r--r--hadrian/src/Hadrian/Package.hs120
-rw-r--r--hadrian/src/Hadrian/Target.hs29
-rw-r--r--hadrian/src/Hadrian/Utilities.hs406
-rw-r--r--hadrian/src/Main.hs59
-rw-r--r--hadrian/src/Oracles/Flag.hs74
-rw-r--r--hadrian/src/Oracles/ModuleFiles.hs160
-rw-r--r--hadrian/src/Oracles/PackageData.hs66
-rw-r--r--hadrian/src/Oracles/Setting.hs236
-rw-r--r--hadrian/src/Rules.hs123
-rw-r--r--hadrian/src/Rules/Clean.hs23
-rw-r--r--hadrian/src/Rules/Compile.hs81
-rw-r--r--hadrian/src/Rules/Configure.hs43
-rw-r--r--hadrian/src/Rules/Dependencies.hs33
-rw-r--r--hadrian/src/Rules/Documentation.hs197
-rw-r--r--hadrian/src/Rules/Generate.hs482
-rw-r--r--hadrian/src/Rules/Gmp.hs119
-rw-r--r--hadrian/src/Rules/Install.hs336
-rw-r--r--hadrian/src/Rules/Libffi.hs108
-rw-r--r--hadrian/src/Rules/Library.hs103
-rw-r--r--hadrian/src/Rules/PackageData.hs119
-rw-r--r--hadrian/src/Rules/Program.hs113
-rw-r--r--hadrian/src/Rules/Register.hs44
-rw-r--r--hadrian/src/Rules/Selftest.hs92
-rw-r--r--hadrian/src/Rules/SourceDist.hs113
-rw-r--r--hadrian/src/Rules/Test.hs72
-rw-r--r--hadrian/src/Rules/Wrappers.hs162
-rw-r--r--hadrian/src/Settings.hs68
-rw-r--r--hadrian/src/Settings/Builders/Alex.hs8
-rw-r--r--hadrian/src/Settings/Builders/Cc.hs26
-rw-r--r--hadrian/src/Settings/Builders/Common.hs58
-rw-r--r--hadrian/src/Settings/Builders/Configure.hs25
-rw-r--r--hadrian/src/Settings/Builders/DeriveConstants.hs39
-rw-r--r--hadrian/src/Settings/Builders/GenPrimopCode.hs24
-rw-r--r--hadrian/src/Settings/Builders/Ghc.hs149
-rw-r--r--hadrian/src/Settings/Builders/GhcCabal.hs118
-rw-r--r--hadrian/src/Settings/Builders/GhcPkg.hs17
-rw-r--r--hadrian/src/Settings/Builders/Haddock.hs63
-rw-r--r--hadrian/src/Settings/Builders/Happy.hs9
-rw-r--r--hadrian/src/Settings/Builders/HsCpp.hs16
-rw-r--r--hadrian/src/Settings/Builders/Hsc2Hs.hs56
-rw-r--r--hadrian/src/Settings/Builders/Ld.hs9
-rw-r--r--hadrian/src/Settings/Builders/Make.hs16
-rw-r--r--hadrian/src/Settings/Builders/Xelatex.hs7
-rw-r--r--hadrian/src/Settings/Default.hs173
-rw-r--r--hadrian/src/Settings/Default.hs-boot20
-rw-r--r--hadrian/src/Settings/Flavours/Development.hs20
-rw-r--r--hadrian/src/Settings/Flavours/Performance.hs18
-rw-r--r--hadrian/src/Settings/Flavours/Profiled.hs19
-rw-r--r--hadrian/src/Settings/Flavours/Quick.hs22
-rw-r--r--hadrian/src/Settings/Flavours/QuickCross.hs24
-rw-r--r--hadrian/src/Settings/Flavours/Quickest.hs23
-rw-r--r--hadrian/src/Settings/Packages/Base.hs12
-rw-r--r--hadrian/src/Settings/Packages/Cabal.hs10
-rw-r--r--hadrian/src/Settings/Packages/Compiler.hs45
-rw-r--r--hadrian/src/Settings/Packages/Ghc.hs13
-rw-r--r--hadrian/src/Settings/Packages/GhcCabal.hs32
-rw-r--r--hadrian/src/Settings/Packages/GhcPkg.hs7
-rw-r--r--hadrian/src/Settings/Packages/GhcPrim.hs12
-rw-r--r--hadrian/src/Settings/Packages/Ghci.hs6
-rw-r--r--hadrian/src/Settings/Packages/Haddock.hs7
-rw-r--r--hadrian/src/Settings/Packages/Haskeline.hs8
-rw-r--r--hadrian/src/Settings/Packages/IntegerGmp.hs24
-rw-r--r--hadrian/src/Settings/Packages/Rts.hs224
-rw-r--r--hadrian/src/Settings/Packages/RunGhc.hs9
-rw-r--r--hadrian/src/Settings/Warnings.hs56
-rw-r--r--hadrian/src/Stage.hs31
-rw-r--r--hadrian/src/Target.hs26
-rw-r--r--hadrian/src/UserSettings.hs64
-rw-r--r--hadrian/src/Utilities.hs88
-rw-r--r--hadrian/src/Way.hs162
89 files changed, 0 insertions, 7382 deletions
diff --git a/hadrian/src/Base.hs b/hadrian/src/Base.hs
deleted file mode 100644
index 38c879234a..0000000000
--- a/hadrian/src/Base.hs
+++ /dev/null
@@ -1,121 +0,0 @@
-module Base (
- -- * General utilities
- module Control.Applicative,
- module Control.Monad.Extra,
- module Data.List.Extra,
- module Data.Maybe,
- module Data.Semigroup,
- module Hadrian.Utilities,
-
- -- * Shake
- module Development.Shake,
- module Development.Shake.Classes,
- module Development.Shake.FilePath,
- module Development.Shake.Util,
-
- -- * Basic data types
- module Hadrian.Package,
- module Stage,
- module Way,
-
- -- * Paths
- hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
- generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
- inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir,
- inplacePackageDbPath, packageDbPath, packageDbStamp
- ) where
-
-import Control.Applicative
-import Control.Monad.Extra
-import Control.Monad.Reader
-import Data.List.Extra
-import Data.Maybe
-import Data.Semigroup
-import Development.Shake hiding (parallel, unit, (*>), Normal)
-import Development.Shake.Classes
-import Development.Shake.FilePath
-import Development.Shake.Util
-import Hadrian.Utilities
-import Hadrian.Package
-
-import Stage
-import Way
-
--- | Hadrian lives in the 'hadrianPath' directory of the GHC tree.
-hadrianPath :: FilePath
-hadrianPath = "hadrian"
-
--- TODO: Move this to build directory?
--- | Path to system configuration files, such as 'configFile'.
-configPath :: FilePath
-configPath = hadrianPath -/- "cfg"
-
--- | Path to the system configuration file generated by the @configure@ script.
-configFile :: FilePath
-configFile = configPath -/- "system.config"
-
--- | Path to source files of the build system, e.g. this file is located at
--- @sourcePath -/- "Base.hs"@. We use this to track some of the source files.
-sourcePath :: FilePath
-sourcePath = hadrianPath -/- "src"
-
--- TODO: Change @mk/config.h@ to @shake-build/cfg/config.h@.
--- | Path to the generated @mk/config.h@ file.
-configH :: FilePath
-configH = "mk/config.h"
-
--- | The directory in 'buildRoot' containing the Shake database and other
--- auxiliary files generated by Hadrian.
-shakeFilesDir :: FilePath
-shakeFilesDir = "hadrian"
-
--- | The directory in 'buildRoot' containing generated source files that are not
--- package-specific, e.g. @ghcplatform.h@.
-generatedDir :: FilePath
-generatedDir = "generated"
-
--- | The directory in 'buildRoot' containing the 'Stage0' package database.
-stage0PackageDbDir :: FilePath
-stage0PackageDbDir = "stage0/bootstrapping.conf"
-
--- | Path to the inplace package database used in 'Stage1' and later.
-inplacePackageDbPath :: FilePath
-inplacePackageDbPath = "inplace/lib/package.conf.d"
-
--- | Path to the package database used in a given 'Stage'.
-packageDbPath :: Stage -> Action FilePath
-packageDbPath Stage0 = buildRoot <&> (-/- stage0PackageDbDir)
-packageDbPath _ = return inplacePackageDbPath
-
--- | We use a stamp file to track the existence of a package database.
-packageDbStamp :: FilePath
-packageDbStamp = ".stamp"
-
--- | Directory for binaries that are built "in place".
-inplaceBinPath :: FilePath
-inplaceBinPath = "inplace/bin"
-
--- | Directory for libraries that are built "in place".
-inplaceLibPath :: FilePath
-inplaceLibPath = "inplace/lib"
-
--- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
-inplaceLibBinPath :: FilePath
-inplaceLibBinPath = "inplace/lib/bin"
-
--- ref: ghc/ghc.mk:142
--- ref: driver/ghc.mk
--- ref: utils/hsc2hs/ghc.mk:35
--- | Files that need to be copied over to 'inplaceLibPath'.
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
- [ "ghc-usage.txt"
- , "ghci-usage.txt"
- , "llvm-targets"
- , "platformConstants"
- , "settings"
- , "template-hsc.h" ]
-
--- | Path to hsc2hs template.
-templateHscPath :: FilePath
-templateHscPath = "inplace/lib/template-hsc.h"
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
deleted file mode 100644
index 2b99c03992..0000000000
--- a/hadrian/src/Builder.hs
+++ /dev/null
@@ -1,296 +0,0 @@
-{-# LANGUAGE InstanceSigs #-}
-module Builder (
- -- * Data types
- ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
- SphinxMode (..), TarMode (..), Builder (..),
-
- -- * Builder properties
- builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
- runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,
- builderEnvironment,
-
- -- * Ad hoc builder invokation
- applyPatch, installDirectory, installData, installScript, installProgram,
- linkSymbolic
- ) where
-
-import Development.Shake.Classes
-import GHC.Generics
-import qualified Hadrian.Builder as H
-import Hadrian.Builder hiding (Builder)
-import Hadrian.Builder.Ar
-import Hadrian.Builder.Sphinx
-import Hadrian.Builder.Tar
-import Hadrian.Oracles.Path
-import Hadrian.Oracles.TextFile
-import Hadrian.Utilities
-import qualified System.Directory.Extra as IO
-
-import Base
-import Context
-import GHC
-import Oracles.Flag
-import Oracles.Setting
-
--- | C compiler can be used in two different modes:
--- * Compile or preprocess a source file.
--- * Extract source dependencies by passing @-MM@ command line argument.
-data CcMode = CompileC | FindCDependencies deriving (Eq, Generic, Show)
-
-instance Binary CcMode
-instance Hashable CcMode
-instance NFData CcMode
-
--- | GHC can be used in four different modes:
--- * Compile a Haskell source file.
--- * 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
- deriving (Eq, Generic, Show)
-
-instance Binary GhcMode
-instance Hashable GhcMode
-instance NFData GhcMode
-
--- | GhcPkg can initialise a package database and register packages in it.
-data GhcPkgMode = Init | Update deriving (Eq, Generic, Show)
-
-instance Binary GhcPkgMode
-instance Hashable GhcPkgMode
-instance NFData GhcPkgMode
-
--- | Haddock can be used in two different modes:
--- * Generate documentation for a single package
--- * Generate an index page for a collection of packages
-data HaddockMode = BuildPackage | BuildIndex deriving (Eq, Generic, Show)
-
-instance Binary HaddockMode
-instance Hashable HaddockMode
-instance NFData HaddockMode
-
--- | A 'Builder' is an external command invoked in a separate process via 'cmd'.
--- @Ghc Stage0@ is the bootstrapping compiler.
--- @Ghc StageN@, N > 0, is the one built in stage (N - 1).
--- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@.
--- @GhcPkg Stage1@ is the one built in Stage0.
-data Builder = Alex
- | Ar ArMode Stage
- | DeriveConstants
- | Cc CcMode Stage
- | Configure FilePath
- | GenApply
- | GenPrimopCode
- | Ghc GhcMode Stage
- | GhcCabal
- | GhcPkg GhcPkgMode Stage
- | Haddock HaddockMode
- | Happy
- | Hpc
- | HsCpp
- | Hsc2Hs
- | Ld
- | Make FilePath
- | Nm
- | Objdump
- | Patch
- | Perl
- | Ranlib
- | Sphinx SphinxMode
- | Tar TarMode
- | Unlit
- | Xelatex
- deriving (Eq, Generic, Show)
-
-instance Binary Builder
-instance Hashable Builder
-instance NFData Builder
-
--- | Some builders are built by this very build system, in which case
--- 'builderProvenance' returns the corresponding build 'Context' (which includes
--- 'Stage' and GHC 'Package').
-builderProvenance :: Builder -> Maybe Context
-builderProvenance = \case
- DeriveConstants -> context Stage0 deriveConstants
- GenApply -> context Stage0 genapply
- GenPrimopCode -> context Stage0 genprimopcode
- Ghc _ Stage0 -> Nothing
- Ghc _ stage -> context (pred stage) ghc
- GhcCabal -> context Stage0 ghcCabal
- GhcPkg _ Stage0 -> Nothing
- GhcPkg _ _ -> context Stage0 ghcPkg
- Haddock _ -> context Stage2 haddock
- Hpc -> context Stage1 hpcBin
- Hsc2Hs -> context Stage0 hsc2hs
- Unlit -> context Stage0 unlit
- _ -> Nothing
- where
- context s p = Just $ vanillaContext s p
-
-instance H.Builder Builder where
- builderPath :: Builder -> Action FilePath
- builderPath builder = case builderProvenance builder of
- Nothing -> systemBuilderPath builder
- Just context -> programPath context
-
- needBuilder :: Builder -> Action ()
- needBuilder builder = do
- path <- H.builderPath builder
- case builder of
- Configure dir -> need [dir -/- "configure"]
- Hsc2Hs -> need [path, templateHscPath]
- Make dir -> need [dir -/- "Makefile"]
- _ -> when (isJust $ builderProvenance builder) $ need [path]
-
- runBuilderWith :: Builder -> BuildInfo -> Action ()
- runBuilderWith builder BuildInfo {..} = do
- path <- builderPath builder
- withResources buildResources $ do
- verbosity <- getVerbosity
- let input = fromSingleton msgIn buildInputs
- msgIn = "[runBuilderWith] Exactly one input file expected."
- output = fromSingleton msgOut buildOutputs
- msgOut = "[runBuilderWith] Exactly one output file expected."
- -- Suppress stdout depending on the Shake's verbosity setting.
- echo = EchoStdout (verbosity >= Loud)
- -- Capture stdout and write it to the output file.
- captureStdout = do
- Stdout stdout <- cmd [path] buildArgs
- writeFileChanged output stdout
- case builder of
- Ar Pack _ -> do
- useTempFile <- flag ArSupportsAtFile
- if useTempFile then runAr path buildArgs
- else runArWithoutTempFile path buildArgs
-
- Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs
-
- Configure dir -> do
- -- Inject /bin/bash into `libtool`, instead of /bin/sh,
- -- otherwise Windows breaks. TODO: Figure out why.
- bash <- bashPath
- let env = AddEnv "CONFIG_SHELL" bash
- cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs
-
- HsCpp -> captureStdout
- GenApply -> captureStdout
-
- GenPrimopCode -> do
- stdin <- readFile' input
- Stdout stdout <- cmd (Stdin stdin) [path] buildArgs
- writeFileChanged output stdout
-
- Make dir -> cmd echo path ["-C", dir] buildArgs
-
- Xelatex -> do
- unit $ cmd [Cwd output] [path] buildArgs
- unit $ cmd [Cwd output] [path] buildArgs
- unit $ cmd [Cwd output] [path] buildArgs
- unit $ cmd [Cwd output] ["makeindex"] (input -<.> "idx")
- unit $ cmd [Cwd output] [path] buildArgs
- unit $ cmd [Cwd output] [path] buildArgs
-
- _ -> cmd echo [path] buildArgs
-
--- TODO: Some builders are required only on certain platforms. For example,
--- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
--- specific optional builders as soon as we can reliably test this feature.
--- See https://github.com/snowleopard/hadrian/issues/211.
-isOptional :: Builder -> Bool
-isOptional = \case
- Objdump -> True
- _ -> False
-
--- | Determine the location of a system 'Builder'.
-systemBuilderPath :: Builder -> Action FilePath
-systemBuilderPath builder = case builder of
- Alex -> fromKey "alex"
- Ar _ Stage0 -> fromKey "system-ar"
- Ar _ _ -> fromKey "ar"
- Cc _ Stage0 -> fromKey "system-cc"
- Cc _ _ -> fromKey "cc"
- -- We can't ask configure for the path to configure!
- Configure _ -> return "configure"
- Ghc _ Stage0 -> fromKey "system-ghc"
- GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
- Happy -> fromKey "happy"
- HsCpp -> fromKey "hs-cpp"
- Ld -> fromKey "ld"
- Make _ -> fromKey "make"
- Nm -> fromKey "nm"
- Objdump -> fromKey "objdump"
- Patch -> fromKey "patch"
- Perl -> fromKey "perl"
- Ranlib -> fromKey "ranlib"
- Sphinx _ -> fromKey "sphinx-build"
- Tar _ -> fromKey "tar"
- Xelatex -> fromKey "xelatex"
- _ -> error $ "No entry for " ++ show builder ++ inCfg
- where
- inCfg = " in " ++ quote configFile ++ " file."
- fromKey key = do
- let unpack = fromMaybe . error $ "Cannot find path to builder "
- ++ quote key ++ inCfg ++ " Did you skip configure?"
- path <- unpack <$> lookupValue configFile key
- if null path
- then do
- unless (isOptional builder) . error $ "Non optional builder "
- ++ quote key ++ " is not specified" ++ inCfg
- return "" -- TODO: Use a safe interface.
- else fixAbsolutePathOnWindows =<< lookupInPath path
-
--- | Was the path to a given system 'Builder' specified in configuration files?
-isSpecified :: Builder -> Action Bool
-isSpecified = fmap (not . null) . systemBuilderPath
-
--- | Apply a patch by executing the 'Patch' builder in a given directory.
-applyPatch :: FilePath -> FilePath -> Action ()
-applyPatch dir patch = do
- let file = dir -/- patch
- needBuilder Patch
- path <- builderPath Patch
- putBuild $ "| Apply patch " ++ file
- quietly $ cmd [Cwd dir, FileStdin file] [path, "-p0"]
-
--- | Install a directory.
-installDirectory :: FilePath -> Action ()
-installDirectory dir = do
- path <- fixAbsolutePathOnWindows =<< setting InstallDir
- putBuild $ "| Install directory " ++ dir
- quietly $ cmd path dir
-
--- | Install data files to a directory and track them.
-installData :: [FilePath] -> FilePath -> Action ()
-installData fs dir = do
- path <- fixAbsolutePathOnWindows =<< setting InstallData
- need fs
- forM_ fs $ \f -> putBuild $ "| Install data " ++ f ++ " to " ++ dir
- quietly $ cmd path fs dir
-
--- | Install an executable file to a directory and track it.
-installProgram :: FilePath -> FilePath -> Action ()
-installProgram f dir = do
- path <- fixAbsolutePathOnWindows =<< setting InstallProgram
- need [f]
- putBuild $ "| Install program " ++ f ++ " to " ++ dir
- quietly $ cmd path f dir
-
--- | Install an executable script to a directory and track it.
-installScript :: FilePath -> FilePath -> Action ()
-installScript f dir = do
- path <- fixAbsolutePathOnWindows =<< setting InstallScript
- need [f]
- putBuild $ "| Install script " ++ f ++ " to " ++ dir
- quietly $ cmd path f dir
-
--- | Create a symbolic link from source file to target file (when symbolic links
--- are supported) and track the source file.
-linkSymbolic :: FilePath -> FilePath -> Action ()
-linkSymbolic source target = do
- lns <- setting LnS
- unless (null lns) $ do
- need [source] -- Guarantee source is built before printing progress info.
- let dir = takeDirectory target
- liftIO $ IO.createDirectoryIfMissing True dir
- putProgressInfo =<< renderAction "Create symbolic link" source target
- quietly $ cmd lns source target
diff --git a/hadrian/src/CommandLine.hs b/hadrian/src/CommandLine.hs
deleted file mode 100644
index 2344dcc99c..0000000000
--- a/hadrian/src/CommandLine.hs
+++ /dev/null
@@ -1,137 +0,0 @@
-module CommandLine (
- optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple,
- cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects,
- cmdInstallDestDir
- ) where
-
-import Data.Either
-import qualified Data.HashMap.Strict as Map
-import Data.List.Extra
-import Development.Shake hiding (Normal)
-import Hadrian.Utilities
-import System.Console.GetOpt
-import System.Environment
-
--- | All arguments that can be passed to Hadrian via the command line.
-data CommandLineArgs = CommandLineArgs
- { configure :: Bool
- , flavour :: Maybe String
- , freeze1 :: Bool
- , installDestDir :: Maybe String
- , integerSimple :: Bool
- , progressColour :: UseColour
- , progressInfo :: ProgressInfo
- , splitObjects :: Bool }
- deriving (Eq, Show)
-
--- | Default values for 'CommandLineArgs'.
-defaultCommandLineArgs :: CommandLineArgs
-defaultCommandLineArgs = CommandLineArgs
- { configure = False
- , flavour = Nothing
- , freeze1 = False
- , installDestDir = Nothing
- , integerSimple = False
- , progressColour = Auto
- , progressInfo = Brief
- , splitObjects = False }
-
-readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
-readConfigure = Right $ \flags -> flags { configure = True }
-
-readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
-
-readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
-readFreeze1 = Right $ \flags -> flags { freeze1 = True }
-
-readInstallDestDir :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readInstallDestDir ms = Right $ \flags -> flags { installDestDir = ms }
-
-readIntegerSimple :: Either String (CommandLineArgs -> CommandLineArgs)
-readIntegerSimple = Right $ \flags -> flags { integerSimple = True }
-
-readProgressColour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readProgressColour ms =
- maybe (Left "Cannot parse progress-colour") (Right . set) (go =<< lower <$> ms)
- where
- go :: String -> Maybe UseColour
- go "never" = Just Never
- go "auto" = Just Auto
- go "always" = Just Always
- go _ = Nothing
- set :: UseColour -> CommandLineArgs -> CommandLineArgs
- set flag flags = flags { progressColour = flag }
-
-readProgressInfo :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readProgressInfo ms =
- maybe (Left "Cannot parse progress-info") (Right . set) (go =<< lower <$> ms)
- where
- go :: String -> Maybe ProgressInfo
- go "none" = Just None
- go "brief" = Just Brief
- go "normal" = Just Normal
- go "unicorn" = Just Unicorn
- go _ = Nothing
- set :: ProgressInfo -> CommandLineArgs -> CommandLineArgs
- set flag flags = flags { progressInfo = flag }
-
-readSplitObjects :: Either String (CommandLineArgs -> CommandLineArgs)
-readSplitObjects = Right $ \flags -> flags { splitObjects = True }
-
--- | Standard 'OptDescr' descriptions of Hadrian's command line arguments.
-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)."
- , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
- "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
- , Option [] ["freeze1"] (NoArg readFreeze1)
- "Freeze Stage1 GHC."
- , Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
- "Installation destination directory."
- , Option [] ["integer-simple"] (NoArg readIntegerSimple)
- "Build GHC with integer-simple library."
- , Option [] ["progress-colour"] (OptArg readProgressColour "MODE")
- "Use colours in progress info (Never, Auto or Always)."
- , Option [] ["progress-info"] (OptArg readProgressInfo "STYLE")
- "Progress info style (None, Brief, Normal or Unicorn)."
- , Option [] ["split-objects"] (NoArg readSplitObjects)
- "Generate split objects (requires a full clean rebuild)." ]
-
--- | A type-indexed map containing Hadrian command line arguments to be passed
--- to Shake via 'shakeExtra'.
-cmdLineArgsMap :: IO (Map.HashMap TypeRep Dynamic)
-cmdLineArgsMap = do
- (opts, _, _) <- getOpt Permute optDescrs <$> getArgs
- let args = foldl (flip id) defaultCommandLineArgs (rights opts)
- return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities
- $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities
- $ insertExtra args Map.empty
-
-cmdLineArgs :: Action CommandLineArgs
-cmdLineArgs = userSetting defaultCommandLineArgs
-
-cmdConfigure :: Action Bool
-cmdConfigure = configure <$> cmdLineArgs
-
-cmdFlavour :: Action (Maybe String)
-cmdFlavour = flavour <$> cmdLineArgs
-
-lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
-lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
-
-cmdInstallDestDir :: Action (Maybe String)
-cmdInstallDestDir = installDestDir <$> cmdLineArgs
-
-cmdIntegerSimple :: Action Bool
-cmdIntegerSimple = integerSimple <$> cmdLineArgs
-
-cmdProgressColour :: Action UseColour
-cmdProgressColour = progressColour <$> cmdLineArgs
-
-cmdProgressInfo :: Action ProgressInfo
-cmdProgressInfo = progressInfo <$> cmdLineArgs
-
-cmdSplitObjects :: Action Bool
-cmdSplitObjects = splitObjects <$> cmdLineArgs
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
deleted file mode 100644
index ad1a2d7295..0000000000
--- a/hadrian/src/Context.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-module Context (
- -- * Context
- Context (..), vanillaContext, stageContext,
-
- -- * Expressions
- getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
- withHsPackage,
-
- -- * Paths
- contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile,
- pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile,
- pkgConfFile, objectPath
- ) where
-
-import GHC.Generics
-import Hadrian.Expression
-import Hadrian.Haskell.Cabal
-
-import Base
-import Oracles.Setting
-
--- | Build context for a currently built 'Target'. We generate potentially
--- different build rules for each 'Context'.
-data Context = Context
- { stage :: Stage -- ^ Currently build Stage
- , package :: Package -- ^ Currently build Package
- , way :: Way -- ^ Currently build Way (usually 'vanilla')
- } deriving (Eq, Generic, Show)
-
-instance Binary Context
-instance Hashable Context
-instance NFData Context
-
--- | Most targets are built only one way, hence the notion of 'vanillaContext'.
-vanillaContext :: Stage -> Package -> Context
-vanillaContext s p = Context s p vanilla
-
--- | Partial context with undefined 'Package' field. Useful for 'Packages'
--- expressions that only read the environment and current 'Stage'.
-stageContext :: Stage -> Context
-stageContext s = vanillaContext s $ error "stageContext: package not set"
-
--- | Get the 'Stage' of the current 'Context'.
-getStage :: Expr Context b Stage
-getStage = stage <$> getContext
-
--- | Get the 'Package' of the current 'Context'.
-getPackage :: Expr Context b Package
-getPackage = package <$> getContext
-
--- | Get the 'Way' of the current 'Context'.
-getWay :: Expr Context b Way
-getWay = way <$> getContext
-
--- | Get a list of configuration settings for the current stage.
-getStagedSettingList :: (Stage -> SettingList) -> Args Context b
-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.
-withHsPackage :: (Monoid a, Semigroup a) => (FilePath -> Expr Context b a) -> Expr Context b a
-withHsPackage expr = do
- pkg <- getPackage
- 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
-
--- | Path to the directory containing build artefacts of a given 'Context'.
-buildPath :: Context -> Action FilePath
-buildPath context = buildRoot <&> (-/- contextDir context)
-
--- | Get the build path of the current 'Context'.
-getBuildPath :: Expr Context b FilePath
-getBuildPath = expr . buildPath =<< getContext
-
-pkgId :: Package -> Action FilePath
-pkgId package = case pkgCabalFile package of
- Just file -> pkgIdentifier file
- Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts
-
-pkgFile :: Context -> String -> String -> Action FilePath
-pkgFile context@Context {..} prefix suffix = do
- path <- buildPath context
- pid <- pkgId package
- 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
- return $ path -/- "inplace-pkg-config"
-
--- | Path to the @package-data.mk@ of a given 'Context'.
-pkgDataFile :: Context -> Action FilePath
-pkgDataFile context = do
- path <- buildPath context
- return $ path -/- "package-data.mk"
-
--- | Path to the @setup-config@ of a given 'Context'.
-pkgSetupConfigFile :: Context -> Action FilePath
-pkgSetupConfigFile context = do
- path <- buildPath context
- return $ path -/- "setup-config"
-
--- | Path to the haddock file of a given 'Context', e.g.:
--- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
-pkgHaddockFile :: Context -> Action FilePath
-pkgHaddockFile Context {..} = do
- root <- buildRoot
- let name = pkgName package
- return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
-
--- | Path to the library file of a given 'Context', e.g.:
--- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
-pkgLibraryFile :: Context -> Action FilePath
-pkgLibraryFile context@Context {..} = do
- extension <- libsuf way
- pkgFile context "libHS" extension
-
--- | Path to the auxiliary library file of a given 'Context', e.g.:
--- @_build/stage1/compiler/build/libHSghc-8.1-0.a@.
-pkgLibraryFile0 :: Context -> Action FilePath
-pkgLibraryFile0 context@Context {..} = do
- extension <- libsuf way
- pkgFile context "libHS" ("-0" ++ extension)
-
--- | Path to the GHCi library file of a given 'Context', e.g.:
--- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
-pkgGhciLibraryFile :: Context -> Action FilePath
-pkgGhciLibraryFile context = pkgFile context "HS" ".o"
-
--- | Path to the configuration file of a given 'Context'.
-pkgConfFile :: Context -> Action FilePath
-pkgConfFile Context {..} = do
- root <- buildRoot
- pid <- pkgId package
- let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
- | otherwise = inplacePackageDbPath
- return $ dbDir -/- pid <.> "conf"
-
--- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
--- to its object file. For example:
--- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
--- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
-objectPath :: Context -> FilePath -> Action FilePath
-objectPath context@Context {..} src = do
- isGenerated <- isGeneratedSource src
- path <- buildPath context
- let extension = drop 1 $ takeExtension src
- obj = src -<.> osuf way
- result | isGenerated = obj
- | "*hs*" ?== extension = path -/- obj
- | otherwise = path -/- extension -/- obj
- return result
diff --git a/hadrian/src/Environment.hs b/hadrian/src/Environment.hs
deleted file mode 100644
index de43efa924..0000000000
--- a/hadrian/src/Environment.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Environment (setupEnvironment) where
-
-import System.Environment
-
--- | The build system invokes many external builders whose behaviour is
--- influenced by the environment variables. We need to modify some of them
--- for better robustness of the build system.
-setupEnvironment :: IO ()
-setupEnvironment = do
- -- ghc-cabal refuses to work when GHC_PACKAGE_PATH is set (e.g. by Stack)
- unsetEnv "GHC_PACKAGE_PATH"
-
- -- in MinGW if PWD is set to a Windows "C:\\" style path then configure
- -- `pwd` will return the Windows path, and then modifying $PATH will fail.
- -- See https://github.com/snowleopard/hadrian/issues/189 for details.
- unsetEnv "PWD"
diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs
deleted file mode 100644
index 7e8220e675..0000000000
--- a/hadrian/src/Expression.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-module Expression (
- -- * Expressions
- Expr, Predicate, Args, Ways,
-
- -- ** Construction and modification
- expr, exprIO, arg, remove,
-
- -- ** Predicates
- (?), stage, stage0, stage1, stage2, notStage0, package, notPackage,
- libraryPackage, builder, way, input, inputs, output, outputs,
-
- -- ** Evaluation
- interpret, interpretInContext,
-
- -- * Convenient accessors
- getBuildRoot, getContext, getPkgData, getPkgDataList, getOutputs, getInputs,
- getInput, getOutput,
-
- -- * Re-exports
- module Base,
- module Builder,
- module Context,
- module GHC
- ) where
-
-import qualified Hadrian.Expression as H
-import Hadrian.Expression hiding (Expr, Predicate, Args)
-
-import Base
-import Builder
-import GHC
-import Context hiding (stage, package, way)
-import Oracles.PackageData
-
--- | @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
-
--- | The following expressions are used throughout the build system for
--- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
--- and 'Packages'.
-type Predicate = H.Predicate Context Builder
-type Args = H.Args Context Builder
-type Ways = Expr [Way]
-
--- | 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
-
--- | Is the build currently in the provided stage?
-stage :: Stage -> Predicate
-stage s = (s ==) <$> getStage
-
--- | Is a particular package being built?
-package :: Package -> Predicate
-package p = (p ==) <$> getPackage
-
--- | This type class allows the user to construct both precise builder
--- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
--- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
--- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
-class BuilderPredicate a where
- -- | Is a particular builder being used?
- builder :: a -> Predicate
-
-instance BuilderPredicate Builder where
- builder b = (b ==) <$> getBuilder
-
-instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
- builder f = builder . f =<< getStage
-
-instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
- builder f = do
- b <- getBuilder
- case b of
- Cc c _ -> builder (f c)
- _ -> return False
-
-instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
- builder f = do
- b <- getBuilder
- case b of
- Ghc c _ -> builder (f c)
- _ -> return False
-
-instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
- builder f = do
- b <- getBuilder
- case b of
- Configure path -> builder (f path)
- _ -> return False
-
--- | Is the current build 'Way' equal to a certain value?
-way :: Way -> Predicate
-way w = (w ==) <$> getWay
-
--- | Is the build currently in stage 0?
-stage0 :: Predicate
-stage0 = stage Stage0
-
--- | Is the build currently in stage 1?
-stage1 :: Predicate
-stage1 = stage Stage1
-
--- | Is the build currently in stage 2?
-stage2 :: Predicate
-stage2 = stage Stage2
-
--- | Is the build /not/ in stage 0 right now?
-notStage0 :: Predicate
-notStage0 = notM stage0
-
--- | Is a certain package /not/ built right now?
-notPackage :: Package -> Predicate
-notPackage = notM . package
-
--- | Is a library package currently being built?
-libraryPackage :: Predicate
-libraryPackage = isLibrary <$> getPackage
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
deleted file mode 100644
index fcbbb70d45..0000000000
--- a/hadrian/src/Flavour.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Flavour (Flavour (..)) where
-
-import Expression
-
--- Please update doc/{flavours.md, user-settings.md} when changing this file.
--- | 'Flavour' is a collection of build settings that fully define a GHC build.
--- Note the following type semantics:
--- * @Bool@: a plain Boolean flag whose value is known at compile time.
--- * @Action Bool@: a flag whose value can depend on the build environment.
--- * @Predicate@: a flag whose value can depend on the build environment and
--- on the current build target.
-data Flavour = Flavour {
- -- | Flavour name, to select this flavour from command line.
- name :: String,
- -- | Use these command line arguments.
- args :: Args,
- -- | Build these packages.
- packages :: Stage -> Action [Package],
- -- | Either 'integerGmp' or 'integerSimple'.
- integerLibrary :: Action Package,
- -- | Build libraries these ways.
- libraryWays :: Ways,
- -- | Build RTS these ways.
- rtsWays :: Ways,
- -- | Build split objects.
- splitObjects :: Predicate,
- -- | Build dynamic GHC programs.
- dynamicGhcPrograms :: Bool,
- -- | Enable GHCi debugger.
- ghciWithDebugger :: Bool,
- -- | Build profiled GHC.
- ghcProfiled :: Bool,
- -- | Build GHC with debug information.
- ghcDebugged :: Bool }
diff --git a/hadrian/src/GHC.hs b/hadrian/src/GHC.hs
deleted file mode 100644
index baae940959..0000000000
--- a/hadrian/src/GHC.hs
+++ /dev/null
@@ -1,289 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module GHC (
- -- * GHC packages
- array, base, binary, bytestring, cabal, compareSizes, compiler, containers,
- 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, libffi, mtl, parsec, parallel, pretty, primitive,
- process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy,
- transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,
- defaultPackages,
-
- -- * Package information
- programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
-
- -- * Miscellaneous
- programPath, ghcSplitPath, stripCmdPath, buildDll0
- ) where
-
-import Base
-import CommandLine
-import Context
-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, 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 = hsPrg "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 = 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 }
-
--- | Packages that are built by default. You can change this in "UserSettings".
-defaultPackages :: Stage -> Action [Package]
-defaultPackages Stage0 = stage0Packages
-defaultPackages Stage1 = stage1Packages
-defaultPackages Stage2 = stage2Packages
-defaultPackages Stage3 = return []
-
-stage0Packages :: Action [Package]
-stage0Packages = do
- win <- windowsHost
- ios <- iosHost
- cross <- crossCompiling
- return $ [ binary
- , cabal
- , compareSizes
- , compiler
- , deriveConstants
- , genapply
- , genprimopcode
- , ghc
- , ghcBoot
- , ghcBootTh
- , ghcCabal
- , ghci
- , ghcPkg
- , ghcTags
- , hsc2hs
- , hp2ps
- , hpc
- , mtl
- , parsec
- , templateHaskell
- , text
- , transformers
- , unlit ]
- ++ [ terminfo | not win, not ios, not cross ]
- ++ [ touchy | win ]
-
-stage1Packages :: Action [Package]
-stage1Packages = do
- win <- windowsHost
- intSimple <- cmdIntegerSimple
- libraries0 <- filter isLibrary <$> stage0Packages
- return $ libraries0 -- Build all Stage0 libraries in Stage1
- ++ [ array
- , base
- , bytestring
- , containers
- , deepseq
- , directory
- , filepath
- , ghc
- , ghcCabal
- , ghcCompact
- , ghcPrim
- , haskeline
- , hpcBin
- , hsc2hs
- , if intSimple then integerSimple else integerGmp
- , pretty
- , process
- , rts
- , runGhc
- , stm
- , time
- , xhtml ]
- ++ [ iservBin | not win ]
- ++ [ unix | not win ]
- ++ [ win32 | win ]
-
-stage2Packages :: Action [Package]
-stage2Packages = return [haddock]
-
--- | Given a 'Context', compute the name of the program that is built in it
--- 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
-
--- | 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 current implementation installs the /latest/ build stage of a package.
-installStage :: Package -> Action (Maybe Stage)
-installStage pkg
- | not (isGhcPackage pkg) = return Nothing -- Only GHC packages are installed
- | otherwise = do
- 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
- 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
-
--- | 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])
- || package == ghcCabal && stage == Stage0
-
--- | Some program packages should not be linked with Haskell main function.
-nonHsMainPackage :: Package -> Bool
-nonHsMainPackage = (`elem` [ghc, hp2ps, iservBin, touchy, unlit])
-
--- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
-autogenPath :: Context -> Action FilePath
-autogenPath context@Context {..}
- | isLibrary package = autogen "build"
- | package == ghc = autogen "build/ghc"
- | package == hpcBin = autogen "build/hpc"
- | package == iservBin = autogen "build/iserv"
- | otherwise = autogen $ "build" -/- pkgName package
- where
- autogen dir = buildPath context <&> (-/- dir -/- "autogen")
-
--- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
--- generated in "Rules.Generators.GhcSplit".
-ghcSplitPath :: FilePath
-ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
-
--- ref: mk/config.mk
--- | Command line tool for stripping.
-stripCmdPath :: Action FilePath
-stripCmdPath = do
- targetPlatform <- setting TargetPlatform
- top <- topDirectory
- case targetPlatform of
- "x86_64-unknown-mingw32" ->
- return (top -/- "inplace/mingw/bin/strip.exe")
- "arm-unknown-linux" ->
- return ":" -- HACK: from the make-based system, see the ref above
- _ -> return "strip"
-
-buildDll0 :: Context -> Action Bool
-buildDll0 Context {..} = do
- windows <- windowsHost
- return $ windows && stage == Stage1 && package == compiler
diff --git a/hadrian/src/Hadrian/Builder.hs b/hadrian/src/Hadrian/Builder.hs
deleted file mode 100644
index 4de658edc3..0000000000
--- a/hadrian/src/Hadrian/Builder.hs
+++ /dev/null
@@ -1,125 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Builder
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- A typical build system invokes several build tools, or /builders/, such as
--- compilers, linkers, etc., some of which may be built by the build system
--- itself. This module defines the 'Builder' type class and a few associated
--- functions that can be used to invoke builders.
------------------------------------------------------------------------------
-module Hadrian.Builder (
- Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions,
- build, buildWithResources, buildWithCmdOptions, getBuilderPath,
- builderEnvironment
- ) where
-
-import Data.List
-import Development.Shake
-
-import Hadrian.Expression hiding (inputs, outputs)
-import Hadrian.Oracles.ArgsHash
-import Hadrian.Target
-import Hadrian.Utilities
-
--- | This data structure captures all information relevant to invoking a builder.
-data BuildInfo = BuildInfo {
- -- | Command line arguments.
- buildArgs :: [String],
- -- | Input files.
- buildInputs :: [FilePath],
- -- | Output files.
- buildOutputs :: [FilePath],
- -- | Options to be passed to Shake's 'cmd' function.
- buildOptions :: [CmdOption],
- -- | Resources to be aquired.
- buildResources :: [(Resource, Int)] }
-
-class ShakeValue b => Builder b where
- -- | The path to a builder.
- builderPath :: b -> Action FilePath
-
- -- | Make sure a builder exists and rebuild it if out of date.
- needBuilder :: b -> Action ()
- needBuilder builder = do
- path <- builderPath builder
- need [path]
-
- -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
- runBuilderWith :: b -> BuildInfo -> Action ()
- runBuilderWith builder buildInfo = do
- let args = buildArgs buildInfo
- needBuilder builder
- path <- builderPath builder
- let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")"
- putBuild $ "| Run " ++ show builder ++ msg
- quietly $ cmd (buildOptions buildInfo) [path] args
-
--- | Run a builder with a specified list of command line arguments, reading a
--- list of input files and writing a list of output files. A lightweight version
--- of 'runBuilderWith'.
-runBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()
-runBuilder = runBuilderWithCmdOptions []
-
--- | Like 'runBuilder' but passes given options to Shake's 'cmd'.
-runBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()
-runBuilderWithCmdOptions opts builder args inputs outputs =
- runBuilderWith builder $ BuildInfo { buildArgs = args
- , buildInputs = inputs
- , buildOutputs = outputs
- , buildOptions = opts
- , buildResources = [] }
-
--- | Build a 'Target' using the list of command line arguments computed from a
--- given 'Args' expression. Force a rebuild if the argument list has changed
--- since the last build.
-build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()
-build = buildWith [] []
-
--- | Like 'build' but acquires necessary resources.
-buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
-buildWithResources rs = buildWith 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 []
-
-buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
-buildWith rs opts target args = do
- needBuilder (builder target)
- argList <- interpret target args
- trackArgsHash target -- Rerun the rule if the hash of argList has changed.
- putInfo target
- verbose <- interpret target verboseCommand
- let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
- quietlyUnlessVerbose $ runBuilderWith (builder target) $
- BuildInfo { buildArgs = argList
- , buildInputs = inputs target
- , buildOutputs = outputs target
- , buildOptions = opts
- , buildResources = rs }
-
--- | Print out information about the command being executed.
-putInfo :: Show b => Target c b -> Action ()
-putInfo t = putProgressInfo =<< renderAction
- ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
- (digest $ inputs t)
- (digest $ outputs 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
-
--- | Write a builder path into a given environment variable.
-builderEnvironment :: Builder b => String -> b -> Action CmdOption
-builderEnvironment variable builder = do
- needBuilder builder
- path <- builderPath builder
- return $ AddEnv variable path
diff --git a/hadrian/src/Hadrian/Builder/Ar.hs b/hadrian/src/Hadrian/Builder/Ar.hs
deleted file mode 100644
index ad74653db0..0000000000
--- a/hadrian/src/Hadrian/Builder/Ar.hs
+++ /dev/null
@@ -1,68 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Builder.Ar
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Support for invoking the archiving utility @ar@. We take care not to exceed
--- the limit on command line length, which differs across supported operating
--- systems (see 'cmdLineLengthLimit'). We need to handle @ar@ in a special way
--- because we sometimes archive __a lot__ of files (in the Cabal library, for
--- example, command line length can reach 2MB!). To work around the limit on the
--- command line length we pass the list of files to be archived via a temporary
--- file (see 'runAr'), or alternatively, we split the argument list into chunks
--- and call @ar@ multiple times, e.g. when passing arguments via a temporary
--- file is not supported (see 'runArWithoutTempFile').
------------------------------------------------------------------------------
-module Hadrian.Builder.Ar (ArMode (..), args, runAr, runArWithoutTempFile) where
-
-import Control.Monad
-import Development.Shake
-import Development.Shake.Classes
-import GHC.Generics
-import Hadrian.Expression
-import Hadrian.Utilities
-
--- | We support packing and unpacking archives with @ar@.
-data ArMode = Pack | Unpack deriving (Eq, Generic, Show)
-
-instance Binary ArMode
-instance Hashable ArMode
-instance NFData ArMode
-
--- NOTE: Make sure to appropriately update 'arFlagsCount' when changing 'args'.
--- | Default command line arguments for invoking the archiving utility @ar@.
-args :: (ShakeValue c, ShakeValue b) => ArMode -> Args c b
-args Pack = mconcat [ arg "q", arg =<< getOutput, getInputs ]
-args Unpack = mconcat [ arg "x", arg =<< getInput ]
-
--- This count includes "q" and the output file argumentes in 'args'. This is
--- only relevant for the 'Pack' @ar@ mode.
-arFlagsCount :: Int
-arFlagsCount = 2
-
--- | Invoke @ar@ given a path to it and a list of arguments. The list of files
--- to be archived is passed via a temporary file. Passing arguments via a
--- temporary file is not supported by some versions of @ar@, in which case you
--- should use 'runArWithoutTempFile' instead.
-runAr :: FilePath -> [String] -> Action ()
-runAr arPath argList = withTempFile $ \tmp -> do
- writeFile' tmp $ unwords fileArgs
- cmd [arPath] flagArgs ('@' : tmp)
- where
- flagArgs = take arFlagsCount argList
- fileArgs = drop arFlagsCount argList
-
--- | Invoke @ar@ given a path to it and a list of arguments. Note that @ar@
--- will be called multiple times if the list of files to be archived is too
--- long and doesn't fit into the command line length limit. This function is
--- typically much slower than 'runAr'.
-runArWithoutTempFile :: FilePath -> [String] -> Action ()
-runArWithoutTempFile arPath argList =
- forM_ (chunksOfSize cmdLineLengthLimit fileArgs) $ \argsChunk ->
- unit . cmd [arPath] $ flagArgs ++ argsChunk
- where
- flagArgs = take arFlagsCount argList
- fileArgs = drop arFlagsCount argList
diff --git a/hadrian/src/Hadrian/Builder/Sphinx.hs b/hadrian/src/Hadrian/Builder/Sphinx.hs
deleted file mode 100644
index 44b522c4d3..0000000000
--- a/hadrian/src/Hadrian/Builder/Sphinx.hs
+++ /dev/null
@@ -1,39 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Builder.Sphinx
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Support for invoking the documentation utility Sphinx.
------------------------------------------------------------------------------
-module Hadrian.Builder.Sphinx (SphinxMode (..), args) where
-
-import Development.Shake
-import Development.Shake.Classes
-import GHC.Generics
-import Hadrian.Expression
-import Hadrian.Utilities
-
--- | Sphinx can be used in three different modes to convert reStructuredText
--- documents into HTML, LaTeX or Man pages.
-data SphinxMode = Html | Latex | Man deriving (Eq, Generic, Show)
-
-instance Binary SphinxMode
-instance Hashable SphinxMode
-instance NFData SphinxMode
-
--- | Default command line arguments for invoking the archiving utility @tar@.
-args :: (ShakeValue c, ShakeValue b) => SphinxMode -> Args c b
-args mode = do
- outPath <- getOutput
- mconcat [ arg "-b", arg modeString
- , arg "-d", arg $ outPath -/- (".doctrees-" ++ modeString)
- , arg =<< getInput
- , arg outPath ]
- where
- modeString = case mode of
- Html -> "html"
- Latex -> "latex"
- Man -> "man"
diff --git a/hadrian/src/Hadrian/Builder/Tar.hs b/hadrian/src/Hadrian/Builder/Tar.hs
deleted file mode 100644
index d51e3c7bee..0000000000
--- a/hadrian/src/Hadrian/Builder/Tar.hs
+++ /dev/null
@@ -1,40 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Builder.Tar
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Support for invoking the archiving utility @tar@.
------------------------------------------------------------------------------
-module Hadrian.Builder.Tar (TarMode (..), args) where
-
-import Development.Shake
-import Development.Shake.Classes
-import GHC.Generics
-import Hadrian.Expression
-
--- | Tar can be used to 'Create' an archive or 'Extract' from it.
-data TarMode = Create | Extract deriving (Eq, Generic, Show)
-
-instance Binary TarMode
-instance Hashable TarMode
-instance NFData TarMode
-
--- | Default command line arguments for invoking the archiving utility @tar@.
-args :: (ShakeValue c, ShakeValue b) => TarMode -> Args c b
-args Create = mconcat
- [ arg "-c"
- , output "//*.gz" ? arg "--gzip"
- , output "//*.bz2" ? arg "--bzip2"
- , output "//*.xz" ? arg "--xz"
- , arg "-f", arg =<< getOutput
- , getInputs ]
-args Extract = mconcat
- [ arg "-x"
- , input "*.gz" ? arg "--gzip"
- , input "*.bz2" ? arg "--bzip2"
- , input "*.xz" ? arg "--xz"
- , arg "-f", arg =<< getInput
- , arg "-C", arg =<< getOutput ]
diff --git a/hadrian/src/Hadrian/Expression.hs b/hadrian/src/Hadrian/Expression.hs
deleted file mode 100644
index e5c01f8935..0000000000
--- a/hadrian/src/Hadrian/Expression.hs
+++ /dev/null
@@ -1,153 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
-module Hadrian.Expression (
- -- * Expressions
- Expr, Predicate, Args,
-
- -- ** Construction and modification
- expr, exprIO, arg, remove,
-
- -- ** Predicates
- (?), input, inputs, output, outputs, VerboseCommand (..), verboseCommand,
-
- -- ** Evaluation
- interpret, interpretInContext,
-
- -- * Convenient accessors
- getBuildRoot, getContext, getBuilder, getOutputs, getInputs, getInput, getOutput
- ) where
-
-import Control.Monad.Extra
-import Control.Monad.Trans
-import Control.Monad.Trans.Reader
-import Data.Semigroup
-import Development.Shake
-import Development.Shake.Classes
-
-import qualified Hadrian.Target as Target
-import Hadrian.Target (Target, target)
-import Hadrian.Utilities
-
--- | 'Expr' @c b a@ is a computation that produces a value of type 'Action' @a@
--- and can read parameters of the current build 'Target' @c b@.
-newtype Expr c b a = Expr (ReaderT (Target c b) Action a)
- deriving (Applicative, Functor, Monad)
-
-instance Semigroup a => Semigroup (Expr c b a) where
- Expr x <> Expr y = Expr $ (<>) <$> x <*> y
-
--- TODO: The 'Semigroup a' constraint will at some point become redundant.
-instance (Semigroup a, Monoid a) => Monoid (Expr c b a) where
- mempty = pure mempty
- mappend = (<>)
-
--- | Expressions that compute a Boolean value.
-type Predicate c b = Expr c b Bool
-
--- | Expressions that compute lists of arguments to be passed to builders.
-type Args c b = Expr c b [String]
-
--- | Lift actions independent from the current build 'Target' into the 'Expr'
--- monad.
-expr :: Action a -> Expr c b a
-expr = Expr . lift
-
--- | Lift IO computations independent from the current build 'Target' into the
--- 'Expr' monad.
-exprIO :: IO a -> Expr c b a
-exprIO = Expr . liftIO
-
--- | Remove given elements from a list expression.
-remove :: Eq a => [a] -> Expr c b [a] -> Expr c b [a]
-remove xs e = filter (`notElem` xs) <$> e
-
--- | Add a single argument to 'Args'.
-arg :: String -> Args c b
-arg = pure . pure
-
--- | Values that can be converted to a 'Predicate'.
-class ToPredicate p c b where
- toPredicate :: p -> Predicate c b
-
-infixr 3 ?
-
--- | Apply a predicate to an expression.
-(?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
-p ? e = do
- bool <- toPredicate p
- if bool then e else mempty
-
-instance ToPredicate Bool c b where
- toPredicate = pure
-
-instance ToPredicate p c b => ToPredicate (Action p) c b where
- toPredicate = toPredicate . expr
-
-instance (c ~ c', b ~ b', ToPredicate p c' b') => ToPredicate (Expr c b p) c' b' where
- toPredicate p = toPredicate =<< p
-
--- | Interpret a given expression according to the given 'Target'.
-interpret :: Target c b -> Expr c b a -> Action a
-interpret target (Expr e) = runReaderT e target
-
--- | Interpret a given expression by looking only at the given 'Context'.
-interpretInContext :: c -> Expr c b a -> Action a
-interpretInContext c = interpret $ target c
- (error "contextOnlyTarget: builder not set")
- (error "contextOnlyTarget: inputs not set" )
- (error "contextOnlyTarget: outputs not set")
-
--- | Get the directory of build results.
-getBuildRoot :: Expr c b FilePath
-getBuildRoot = expr buildRoot
-
--- | Get the current build 'Context'.
-getContext :: Expr c b c
-getContext = Expr $ asks Target.context
-
--- | Get the 'Builder' for the current 'Target'.
-getBuilder :: Expr c b b
-getBuilder = Expr $ asks Target.builder
-
--- | Get the input files of the current 'Target'.
-getInputs :: Expr c b [FilePath]
-getInputs = Expr $ asks Target.inputs
-
--- | Run 'getInputs' and check that the result contains one input file only.
-getInput :: (Show b, Show c) => Expr c b FilePath
-getInput = Expr $ do
- target <- ask
- fromSingleton ("Exactly one input file expected in " ++ show target) <$>
- asks Target.inputs
-
--- | Get the files produced by the current 'Target'.
-getOutputs :: Expr c b [FilePath]
-getOutputs = Expr $ asks Target.outputs
-
--- | Run 'getOutputs' and check that the result contains one output file only.
-getOutput :: (Show b, Show c) => Expr c b FilePath
-getOutput = Expr $ do
- target <- ask
- fromSingleton ("Exactly one output file expected in " ++ show target) <$>
- asks Target.outputs
-
--- | Does any of the input files match a given pattern?
-input :: FilePattern -> Predicate c b
-input f = any (f ?==) <$> getInputs
-
--- | Does any of the input files match any of the given patterns?
-inputs :: [FilePattern] -> Predicate c b
-inputs = anyM input
-
--- | Does any of the output files match a given pattern?
-output :: FilePattern -> Predicate c b
-output f = any (f ?==) <$> getOutputs
-
--- | Does any of the output files match any of the given patterns?
-outputs :: [FilePattern] -> Predicate c b
-outputs = anyM output
-
-newtype VerboseCommand c b = VerboseCommand { predicate :: Predicate c b }
- deriving Typeable
-
-verboseCommand :: (ShakeValue c, ShakeValue b) => Predicate c b
-verboseCommand = predicate =<< expr (userSetting . VerboseCommand $ return False)
diff --git a/hadrian/src/Hadrian/Haskell/Cabal.hs b/hadrian/src/Hadrian/Haskell/Cabal.hs
deleted file mode 100644
index ab5f334f9b..0000000000
--- a/hadrian/src/Hadrian/Haskell/Cabal.hs
+++ /dev/null
@@ -1,44 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Haskell.Cabal
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Basic functionality for extracting Haskell package metadata stored in
--- Cabal files.
------------------------------------------------------------------------------
-module Hadrian.Haskell.Cabal (
- pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
- ) where
-
-import Development.Shake
-
-import Hadrian.Haskell.Cabal.Parse
-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
-
--- | 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
-
--- | 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
-
--- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
-pkgSynopsis :: FilePath -> Action String
-pkgSynopsis cabalFile = synopsis <$> readCabalFile cabalFile
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
deleted file mode 100644
index 578eeacc52..0000000000
--- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
+++ /dev/null
@@ -1,63 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Haskell.Cabal.Parse
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Extracting Haskell package metadata stored in Cabal files.
------------------------------------------------------------------------------
-module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where
-
-import Data.List.Extra
-import Development.Shake
-import Development.Shake.Classes
-import qualified Distribution.Package as C
-import qualified Distribution.PackageDescription as C
-import qualified Distribution.PackageDescription.Parse as C
-import qualified Distribution.Text as C
-import qualified Distribution.Types.CondTree as C
-import qualified Distribution.Verbosity as C
-
-import Hadrian.Package
-
--- TODO: Use fine-grain tracking instead of tracking the whole Cabal file.
--- | Haskell package metadata extracted from a Cabal file.
-data Cabal = Cabal
- { dependencies :: [PackageName]
- , name :: PackageName
- , synopsis :: String
- , version :: String
- } deriving (Eq, Read, Show, Typeable)
-
-instance Binary Cabal where
- put = put . show
- get = fmap read get
-
-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` ()
-
--- | 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
diff --git a/hadrian/src/Hadrian/Oracles/ArgsHash.hs b/hadrian/src/Hadrian/Oracles/ArgsHash.hs
deleted file mode 100644
index bae2fdbd80..0000000000
--- a/hadrian/src/Hadrian/Oracles/ArgsHash.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module Hadrian.Oracles.ArgsHash (
- TrackArgument, trackAllArguments, trackArgsHash, argsHashOracle
- ) where
-
-import Control.Monad
-import Development.Shake
-import Development.Shake.Classes
-
-import Hadrian.Expression hiding (inputs, outputs)
-import Hadrian.Target
-
--- | 'TrackArgument' is used to specify the arguments that should be tracked by
--- the @ArgsHash@ oracle. The safest option is to track all arguments, but some
--- arguments, such as @-jN@, do not change the build results, hence there is no
--- need to initiate unnecessary rebuild if they are added to or removed from a
--- command line. If all arguments should be tracked, use 'trackAllArguments'.
-type TrackArgument c b = Target c b -> String -> Bool
-
--- | Returns 'True' for all targets and arguments, hence can be used a safe
--- default for 'argsHashOracle'.
-trackAllArguments :: TrackArgument c b
-trackAllArguments _ _ = True
-
--- | Given a 'Target' this 'Action' determines the corresponding argument list
--- and computes its hash. The resulting value is tracked in a Shake oracle,
--- hence initiating rebuilds when the hash changes (a hash change indicates
--- changes in the build command for the given target).
--- Note: for efficiency we replace the list of input files with its hash to
--- avoid storing long lists of source files passed to some builders (e.g. ar)
--- in the Shake database. This optimisation is normally harmless, because
--- argument list constructors are assumed not to examine target sources, but
--- only append them to argument lists where appropriate.
-trackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()
-trackArgsHash t = do
- let hashedInputs = [ show $ hash (inputs t) ]
- hashedTarget = target (context t) (builder t) hashedInputs (outputs t)
- void (askOracle $ ArgsHash hashedTarget :: Action Int)
-
-newtype ArgsHash c b = ArgsHash (Target c b)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult (ArgsHash c b) = Int
-
--- | This oracle stores per-target argument list hashes in the Shake database,
--- allowing the user to track them between builds using 'trackArgsHash' queries.
-argsHashOracle :: (ShakeValue c, ShakeValue b) => TrackArgument c b -> Args c b -> Rules ()
-argsHashOracle trackArgument args = void $
- addOracle $ \(ArgsHash target) -> do
- argList <- interpret target args
- let trackedArgList = filter (trackArgument target) argList
- return $ hash trackedArgList
diff --git a/hadrian/src/Hadrian/Oracles/DirectoryContents.hs b/hadrian/src/Hadrian/Oracles/DirectoryContents.hs
deleted file mode 100644
index f302af9da0..0000000000
--- a/hadrian/src/Hadrian/Oracles/DirectoryContents.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module Hadrian.Oracles.DirectoryContents (
- directoryContents, copyDirectoryContents, directoryContentsOracle, copyDirectoryContentsUntracked,
- Match (..), matches, matchAll
- ) where
-
-import Control.Monad
-import Development.Shake
-import Development.Shake.Classes
-import Development.Shake.FilePath
-import GHC.Generics
-
-import Hadrian.Utilities
-
-import qualified System.Directory.Extra as IO
-
-data Match = Test FilePattern | Not Match | And [Match] | Or [Match]
- deriving (Generic, Eq, Show, Typeable)
-
-instance Binary Match
-instance Hashable Match
-instance NFData Match
-
--- | A 'Match' expression that always evaluates to 'True' (i.e. always matches).
-matchAll :: Match
-matchAll = And []
-
--- | Check if a file name matches a given 'Match' expression.
-matches :: Match -> FilePath -> Bool
-matches (Test p) f = p ?== f
-matches (Not m) f = not $ matches m f
-matches (And ms) f = all (`matches` f) ms
-matches (Or ms) f = any (`matches` f) ms
-
--- | Given a 'Match' expression and a directory, recursively traverse it and all
--- its subdirectories to find and return all matching contents.
-directoryContents :: Match -> FilePath -> Action [FilePath]
-directoryContents expr dir = askOracle $ DirectoryContents (expr, dir)
-
--- | Copy the contents of the source directory that matches a given 'Match'
--- expression into the target directory. The copied contents is tracked.
-copyDirectoryContents :: Match -> FilePath -> FilePath -> Action ()
-copyDirectoryContents expr source target = do
- putProgressInfo =<< renderAction "Copy directory contents" source target
- let cp file = copyFile file $ target -/- makeRelative source file
- mapM_ cp =<< directoryContents expr source
-
--- | Copy the contents of the source directory that matches a given 'Match'
--- expression into the target directory. The copied contents is untracked.
-copyDirectoryContentsUntracked :: Match -> FilePath -> FilePath -> Action ()
-copyDirectoryContentsUntracked expr source target = do
- putProgressInfo =<< renderAction "Copy directory contents (untracked)" source target
- let cp file = copyFileUntracked file $ target -/- makeRelative source file
- mapM_ cp =<< directoryContents expr source
-
-newtype DirectoryContents = DirectoryContents (Match, FilePath)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult DirectoryContents = [FilePath]
-
--- | This oracle answers 'directoryContents' queries and tracks the results.
-directoryContentsOracle :: Rules ()
-directoryContentsOracle = void $
- addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $ map unifyPath .
- filter (matches expr) <$> IO.listFilesInside (return . matches expr) dir
diff --git a/hadrian/src/Hadrian/Oracles/Path.hs b/hadrian/src/Hadrian/Oracles/Path.hs
deleted file mode 100644
index ceccc23db2..0000000000
--- a/hadrian/src/Hadrian/Oracles/Path.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module Hadrian.Oracles.Path (
- lookupInPath, bashPath, fixAbsolutePathOnWindows, pathOracle
- ) where
-
-import Control.Monad
-import Data.Maybe
-import Data.Char
-import Data.List.Extra
-import Development.Shake
-import Development.Shake.Classes
-import Development.Shake.FilePath
-import System.Directory
-import System.Info.Extra
-
-import Hadrian.Utilities
-
--- | Lookup a specified 'FilePath' in the system @PATH@.
-lookupInPath :: FilePath -> Action FilePath
-lookupInPath name
- | name == takeFileName name = askOracle $ LookupInPath name
- | otherwise = return name
-
--- | Lookup the path to the @bash@ interpreter.
-bashPath :: Action FilePath
-bashPath = lookupInPath "bash"
-
--- | Fix an absolute path on Windows:
--- * "/c/" => "C:/"
--- * "/usr/bin/tar.exe" => "C:/msys/usr/bin/tar.exe"
-fixAbsolutePathOnWindows :: FilePath -> Action FilePath
-fixAbsolutePathOnWindows path =
- if isWindows
- then do
- let (dir, file) = splitFileName path
- winDir <- askOracle $ WindowsPath dir
- return $ winDir -/- file
- else
- return path
-
-newtype LookupInPath = LookupInPath String
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult LookupInPath = String
-
-newtype WindowsPath = WindowsPath FilePath
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult WindowsPath = String
-
--- | Oracles for looking up paths. These are slow and require caching.
-pathOracle :: Rules ()
-pathOracle = do
- void $ addOracle $ \(WindowsPath path) -> do
- Stdout out <- quietly $ cmd ["cygpath", "-m", path]
- let windowsPath = unifyPath $ dropWhileEnd isSpace out
- putLoud $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath
- return windowsPath
-
- void $ addOracle $ \(LookupInPath name) -> do
- let unpack = fromMaybe . error $ "Cannot find executable " ++ quote name
- path <- unifyPath . unpack <$> liftIO (findExecutable name)
- putLoud $ "| Executable found: " ++ name ++ " => " ++ path
- return path
diff --git a/hadrian/src/Hadrian/Oracles/TextFile.hs b/hadrian/src/Hadrian/Oracles/TextFile.hs
deleted file mode 100644
index 6d4f048c7d..0000000000
--- a/hadrian/src/Hadrian/Oracles/TextFile.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Oracles.TextFile
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- Read and parse text files, tracking their contents. This oracle can be used
--- to read configuration or package metadata files and cache the parsing.
------------------------------------------------------------------------------
-module Hadrian.Oracles.TextFile (
- readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
- lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
- readCabalFile, textFileOracle
- ) where
-
-import Control.Monad
-import qualified Data.HashMap.Strict as Map
-import Data.Maybe
-import Development.Shake
-import Development.Shake.Classes
-import Development.Shake.Config
-
-import Hadrian.Haskell.Cabal.Parse
-import Hadrian.Utilities
-
-newtype TextFile = TextFile FilePath
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult TextFile = String
-
-newtype CabalFile = CabalFile FilePath
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult CabalFile = Cabal
-
-newtype KeyValue = KeyValue (FilePath, String)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult KeyValue = Maybe String
-
-newtype KeyValues = KeyValues (FilePath, String)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult KeyValues = Maybe [String]
-
--- | Read a text file, caching and tracking the result. To read and track
--- individual lines of a text file use 'lookupValue' and its derivatives.
-readTextFile :: FilePath -> Action String
-readTextFile = askOracle . TextFile
-
--- | Lookup a value in a text file, tracking the result. Each line of the file
--- is expected to have @key = value@ format.
-lookupValue :: FilePath -> String -> Action (Maybe String)
-lookupValue file key = askOracle $ KeyValue (file, key)
-
--- | Like 'lookupValue' but returns the empty string if the key is not found.
-lookupValueOrEmpty :: FilePath -> String -> Action String
-lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
-
--- | Like 'lookupValue' but raises an error if the key is not found.
-lookupValueOrError :: FilePath -> String -> Action String
-lookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key
- where
- msg = "Key " ++ quote key ++ " not found in file " ++ quote file
-
--- | Lookup a list of values in a text file, tracking the result. Each line of
--- the file is expected to have @key value1 value2 ...@ format.
-lookupValues :: FilePath -> String -> Action (Maybe [String])
-lookupValues file key = askOracle $ KeyValues (file, key)
-
--- | Like 'lookupValues' but returns the empty list if the key is not found.
-lookupValuesOrEmpty :: FilePath -> String -> Action [String]
-lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
-
--- | Like 'lookupValues' but raises an error if the key is not found.
-lookupValuesOrError :: FilePath -> String -> Action [String]
-lookupValuesOrError file key = fromMaybe (error msg) <$> lookupValues file key
- where
- msg = "Key " ++ quote key ++ " not found in file " ++ quote file
-
--- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
--- @file@ in a (typically generated) dependency file @depFile@. The action
--- returns a pair @(source, files)@, such that the @file@ can be produced by
--- compiling @source@, which in turn also depends on a number of other @files@.
-lookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
-lookupDependencies depFile file = do
- deps <- lookupValues depFile file
- case deps of
- Nothing -> error $ "No dependencies found for file " ++ quote file
- Just [] -> error $ "No source file found for file " ++ quote file
- Just (source : files) -> return (source, files)
-
--- | Read and parse a @.cabal@ file, caching and tracking the result.
-readCabalFile :: FilePath -> Action Cabal
-readCabalFile = askOracle . CabalFile
-
--- | This oracle reads and parses text files to answer 'readTextFile' and
--- 'lookupValue' queries, as well as their derivatives, tracking the results.
-textFileOracle :: Rules ()
-textFileOracle = do
- text <- newCache $ \file -> do
- need [file]
- putLoud $ "| TextFile oracle: reading " ++ quote file ++ "..."
- liftIO $ readFile file
- void $ addOracle $ \(TextFile file) -> text file
-
- kv <- newCache $ \file -> do
- need [file]
- putLoud $ "| KeyValue oracle: reading " ++ quote file ++ "..."
- liftIO $ readConfigFile file
- void $ addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
-
- kvs <- newCache $ \file -> do
- need [file]
- putLoud $ "| KeyValues oracle: reading " ++ quote file ++ "..."
- contents <- map words <$> readFileLines 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
diff --git a/hadrian/src/Hadrian/Package.hs b/hadrian/src/Hadrian/Package.hs
deleted file mode 100644
index 11a6998f65..0000000000
--- a/hadrian/src/Hadrian/Package.hs
+++ /dev/null
@@ -1,120 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Hadrian.Package
--- Copyright : (c) Andrey Mokhov 2014-2017
--- License : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability : experimental
---
--- A /package/ is a collection of files. We currently only support C and Haskell
--- packages and treat a package as either a library or a program. The latter is
--- a gross oversimplification as, for example, Haskell packages can be both.
--- This works for now, but should be improved in future.
------------------------------------------------------------------------------
-module Hadrian.Package (
- -- * Data types
- Package (..), PackageName, PackageLanguage, PackageType,
-
- -- * Construction and properties
- cLibrary, cProgram, hsLibrary, hsProgram,
- isLibrary, isProgram, isCPackage, isHsPackage,
-
- -- * Package directory structure
- pkgCabalFile, unsafePkgCabalFile
- ) where
-
-import Data.Maybe
-import Development.Shake.Classes
-import Development.Shake.FilePath
-import GHC.Generics
-import GHC.Stack
-import Hadrian.Utilities
-
-data PackageLanguage = C | Haskell deriving (Generic, Show)
-
--- TODO: Make PackageType more precise.
--- See https://github.com/snowleopard/hadrian/issues/12.
-data PackageType = Library | Program deriving (Generic, Show)
-
-type PackageName = String
-
--- TODO: Consider turning Package into a GADT indexed with language and type.
-data Package = Package {
- -- | The package language. 'C' and 'Haskell' packages are supported.
- pkgLanguage :: PackageLanguage,
- -- | The package type. 'Library' and 'Program' packages are supported.
- pkgType :: PackageType,
- -- | The package name. We assume that all packages have different names,
- -- hence two packages with the same name are considered equal.
- pkgName :: PackageName,
- -- | The path to the package source code relative to the root of the build
- -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the
- -- @Cabal@ and @ghc-bin@ packages in GHC.
- pkgPath :: FilePath
- } deriving (Generic, Show)
-
-instance Eq Package where
- p == q = pkgName p == pkgName q
-
-instance Ord Package where
- compare p q = compare (pkgName p) (pkgName q)
-
-instance Binary PackageLanguage
-instance Hashable PackageLanguage
-instance NFData PackageLanguage
-
-instance Binary PackageType
-instance Hashable PackageType
-instance NFData PackageType
-
-instance Binary Package
-instance Hashable Package
-instance NFData Package
-
--- | Construct a C library package.
-cLibrary :: PackageName -> FilePath -> Package
-cLibrary = Package C Library
-
--- | Construct a C program package.
-cProgram :: PackageName -> FilePath -> Package
-cProgram = Package C Program
-
--- | Construct a Haskell library package.
-hsLibrary :: PackageName -> FilePath -> Package
-hsLibrary = Package Haskell Library
-
--- | Construct a Haskell program package.
-hsProgram :: PackageName -> FilePath -> Package
-hsProgram = Package Haskell Program
-
--- | Is this a library package?
-isLibrary :: Package -> Bool
-isLibrary (Package _ Library _ _) = True
-isLibrary _ = False
-
--- | Is this a program package?
-isProgram :: Package -> Bool
-isProgram (Package _ Program _ _) = True
-isProgram _ = False
-
--- | Is this a C package?
-isCPackage :: Package -> Bool
-isCPackage (Package C _ _ _) = True
-isCPackage _ = False
-
--- | Is this a Haskell package?
-isHsPackage :: Package -> Bool
-isHsPackage (Package Haskell _ _ _) = True
-isHsPackage _ = False
-
--- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@,
--- or @Nothing@ if the argument is not a Haskell package.
-pkgCabalFile :: Package -> Maybe FilePath
-pkgCabalFile p | isHsPackage p = Just $ pkgPath p -/- pkgName p <.> "cabal"
- | otherwise = Nothing
-
--- | Like 'pkgCabalFile' but raises an error on a non-Haskell package.
-unsafePkgCabalFile :: HasCallStack => Package -> FilePath
-unsafePkgCabalFile p = fromMaybe (error msg) (pkgCabalFile p)
- where
- msg = "[unsafePkgCabalFile] Not a Haskell package: " ++ show p
diff --git a/hadrian/src/Hadrian/Target.hs b/hadrian/src/Hadrian/Target.hs
deleted file mode 100644
index 88489776c0..0000000000
--- a/hadrian/src/Hadrian/Target.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-module Hadrian.Target (Target, target, context, builder, inputs, outputs) where
-
-import Development.Shake.Classes
-import GHC.Generics
-
--- | Each invocation of a builder is fully described by a 'Target', which
--- comprises a build context (type variable @c@), a builder (type variable @b@),
--- a list of input files and a list of output files. For example:
---
--- @
--- preludeTarget = Target (GHC.Context) (GHC.Builder)
--- { context = Context Stage1 base profiling
--- , builder = Ghc Stage1
--- , inputs = ["libraries/base/Prelude.hs"]
--- , outputs = ["build/stage1/libraries/base/Prelude.p_o"] }
--- @
-data Target c b = Target
- { context :: c -- ^ Current build context
- , builder :: b -- ^ Builder to be invoked
- , inputs :: [FilePath] -- ^ Input files for the builder
- , outputs :: [FilePath] -- ^ Files to be produced
- } deriving (Eq, Generic, Show)
-
-target :: c -> b -> [FilePath] -> [FilePath] -> Target c b
-target = Target
-
-instance (Binary c, Binary b) => Binary (Target c b)
-instance (Hashable c, Hashable b) => Hashable (Target c b)
-instance (NFData c, NFData b) => NFData (Target c b)
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
deleted file mode 100644
index 1cd22b1179..0000000000
--- a/hadrian/src/Hadrian/Utilities.hs
+++ /dev/null
@@ -1,406 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module Hadrian.Utilities (
- -- * List manipulation
- fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize,
-
- -- * String manipulation
- quote, yesNo,
-
- -- * FilePath manipulation
- unifyPath, (-/-),
-
- -- * Accessing Shake's type-indexed map
- insertExtra, lookupExtra, userSetting,
-
- -- * Paths
- BuildRoot (..), buildRoot, isGeneratedSource,
-
- -- * File system operations
- copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile,
- createDirectory, copyDirectory, moveDirectory, removeDirectory,
-
- -- * Diagnostic info
- UseColour (..), putColoured, BuildProgressColour (..), putBuild,
- SuccessColour (..), putSuccess, ProgressInfo (..),
- putProgressInfo, renderAction, renderProgram, renderLibrary, renderBox,
- renderUnicorn,
-
- -- * Miscellaneous
- (<&>), (%%>), cmdLineLengthLimit,
-
- -- * Useful re-exports
- Dynamic, fromDynamic, toDyn, TypeRep, typeOf
- ) where
-
-import Control.Monad.Extra
-import Data.Char
-import Data.Dynamic (Dynamic, fromDynamic, toDyn)
-import Data.HashMap.Strict (HashMap)
-import Data.List.Extra
-import Data.Maybe
-import Data.Typeable (TypeRep, typeOf)
-import Development.Shake hiding (Normal)
-import Development.Shake.Classes
-import Development.Shake.FilePath
-import System.Console.ANSI
-import System.Info.Extra
-
-import qualified Control.Exception.Base as IO
-import qualified Data.HashMap.Strict as Map
-import qualified System.Directory.Extra as IO
-import qualified System.Info.Extra as IO
-import qualified System.IO as IO
-
--- | Extract a value from a singleton list, or terminate with an error message
--- if the list does not contain exactly one value.
-fromSingleton :: String -> [a] -> a
-fromSingleton _ [res] = res
-fromSingleton msg _ = error msg
-
--- | Find and replace all occurrences of a value in a list.
-replaceEq :: Eq a => a -> a -> [a] -> [a]
-replaceEq from to = map (\cur -> if cur == from then to else cur)
-
--- Explicit definition to avoid dependency on Data.List.Ordered
--- | Difference of two ordered lists.
-minusOrd :: Ord a => [a] -> [a] -> [a]
-minusOrd [] _ = []
-minusOrd xs [] = xs
-minusOrd (x:xs) (y:ys) = case compare x y of
- LT -> x : minusOrd xs (y:ys)
- EQ -> minusOrd xs ys
- GT -> minusOrd (x:xs) ys
-
--- Explicit definition to avoid dependency on Data.List.Ordered. TODO: add tests
--- | Intersection of two ordered lists by a predicate.
-intersectOrd :: (a -> b -> Ordering) -> [a] -> [b] -> [a]
-intersectOrd cmp = loop
- where
- loop [] _ = []
- loop _ [] = []
- loop (x:xs) (y:ys) = case cmp x y of
- LT -> loop xs (y:ys)
- EQ -> x : loop xs (y:ys)
- GT -> loop (x:xs) ys
-
--- | Lookup all elements of a given sorted list in a given sorted dictionary.
--- @lookupAll list dict@ is equivalent to @map (flip lookup dict) list@ but has
--- linear complexity O(|list| + |dist|) instead of quadratic O(|list| * |dict|).
---
--- > lookupAll ["b", "c"] [("a", 1), ("c", 3), ("d", 4)] == [Nothing, Just 3]
--- > list & dict are sorted: lookupAll list dict == map (flip lookup dict) list
-lookupAll :: Ord a => [a] -> [(a, b)] -> [Maybe b]
-lookupAll [] _ = []
-lookupAll (_:xs) [] = Nothing : lookupAll xs []
-lookupAll (x:xs) (y:ys) = case compare x (fst y) of
- LT -> Nothing : lookupAll xs (y:ys)
- EQ -> Just (snd y) : lookupAll xs (y:ys)
- GT -> lookupAll (x:xs) ys
-
--- | @chunksOfSize size strings@ splits a given list of strings into chunks not
--- exceeding the given @size@. If that is impossible, it uses singleton chunks.
-chunksOfSize :: Int -> [String] -> [[String]]
-chunksOfSize n = repeatedly f
- where
- f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs
-
--- | Add single quotes around a String.
-quote :: String -> String
-quote s = "'" ++ s ++ "'"
-
--- | Pretty-print a 'Bool' as a @"YES"@ or @"NO"@ string.
-yesNo :: Bool -> String
-yesNo True = "YES"
-yesNo False = "NO"
-
--- | Normalise a path and convert all path separators to @/@, even on Windows.
-unifyPath :: FilePath -> FilePath
-unifyPath = toStandard . normaliseEx
-
--- | Combine paths with a forward slash regardless of platform.
-(-/-) :: FilePath -> FilePath -> FilePath
-"" -/- b = b
-a -/- b
- | last a == '/' = a ++ b
- | otherwise = a ++ '/' : b
-
-infixr 6 -/-
-
--- | Like Shake's '%>' but gives higher priority to longer patterns. Useful
--- in situations when a family of build rules, e.g. @"//*.a"@ and @"//*_p.a"@
--- can be matched by the same file, such as @library_p.a@. We break the tie
--- by preferring longer matches, which correpond to longer patterns.
-(%%>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()
-p %%> a = priority (fromIntegral (length p) + 1) $ p %> a
-
-infix 1 %%>
-
--- | Build command lines can get very long; for example, when building the Cabal
--- library, they can reach 2MB! Some operating systems do not support command
--- lines of such length, and this function can be used to obtain a reasonable
--- approximation of the limit. On Windows, it is theoretically 32768 characters
--- (since Windows 7). In practice we use 31000 to leave some breathing space for
--- the builder path & name, auxiliary flags, and other overheads. On Mac OS X,
--- ARG_MAX is 262144, yet when using @xargs@ on OSX this is reduced by over
--- 20000. Hence, 200000 seems like a sensible limit. On other operating systems
--- we currently use the 4194304 setting.
-cmdLineLengthLimit :: Int
-cmdLineLengthLimit | isWindows = 31000
- | isMac = 200000
- | otherwise = 4194304
-
--- | Insert a value into Shake's type-indexed map.
-insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
-insertExtra value = Map.insert (typeOf value) (toDyn value)
-
--- | Lookup a value in Shake's type-indexed map.
-lookupExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> a
-lookupExtra defaultValue extra = fromMaybe defaultValue maybeValue
- where
- maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
-
--- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the
--- setting is not found, return the provided default value instead.
-userSetting :: Typeable a => a -> Action a
-userSetting defaultValue = do
- extra <- shakeExtra <$> getShakeOptions
- return $ lookupExtra defaultValue extra
-
-newtype BuildRoot = BuildRoot FilePath deriving Typeable
-
--- | All build results are put into the 'buildRoot' directory.
-buildRoot :: Action FilePath
-buildRoot = do
- BuildRoot path <- userSetting (BuildRoot "")
- return path
-
--- | A version of 'fmap' with flipped arguments. Useful for manipulating values
--- in context, e.g. 'buildRoot', as in the example below.
---
--- @
--- buildRoot <&> (-/- "dir") == fmap (-/- "dir") buildRoot
--- @
-(<&>) :: Functor f => f a -> (a -> b) -> f b
-(<&>) = flip fmap
-
-infixl 1 <&>
-
--- | Given a 'FilePath' to a source file, return 'True' if it is generated.
--- The current implementation simply assumes that a file is generated if it
--- lives in the 'buildRoot' directory. Since most files are not generated the
--- test is usually very fast.
-isGeneratedSource :: FilePath -> Action Bool
-isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
-
--- | Copy a file tracking the source. Create the target directory if missing.
-copyFile :: FilePath -> FilePath -> Action ()
-copyFile source target = do
- need [source] -- Guarantee the source is built before printing progress info.
- let dir = takeDirectory target
- liftIO $ IO.createDirectoryIfMissing True dir
- putProgressInfo =<< renderAction "Copy file" source target
- quietly $ copyFileChanged source target
-
--- | Copy a file without tracking the source. Create the target directory if missing.
-copyFileUntracked :: FilePath -> FilePath -> Action ()
-copyFileUntracked source target = do
- let dir = takeDirectory target
- liftIO $ IO.createDirectoryIfMissing True dir
- putProgressInfo =<< renderAction "Copy file (untracked)" source target
- liftIO $ IO.copyFile source target
-
--- | Transform a given file by applying a function to its contents.
-fixFile :: FilePath -> (String -> String) -> Action ()
-fixFile file f = do
- putProgressInfo $ "| Fix " ++ file
- contents <- liftIO $ IO.withFile file IO.ReadMode $ \h -> do
- old <- IO.hGetContents h
- let new = f old
- IO.evaluate $ rnf new
- return new
- liftIO $ writeFile file contents
-
--- | Make a given file executable by running the @chmod +x@ command.
-makeExecutable :: FilePath -> Action ()
-makeExecutable file = do
- putProgressInfo $ "| Make " ++ quote file ++ " executable."
- quietly $ cmd "chmod +x " [file]
-
--- | Move a file. Note that we cannot track the source, because it is moved.
-moveFile :: FilePath -> FilePath -> Action ()
-moveFile source target = do
- putProgressInfo =<< renderAction "Move file" source target
- quietly $ cmd ["mv", source, target]
-
--- | Remove a file that doesn't necessarily exist.
-removeFile :: FilePath -> Action ()
-removeFile file = do
- putProgressInfo $ "| Remove file " ++ file
- liftIO . whenM (IO.doesFileExist file) $ IO.removeFile file
-
--- | Create a directory if it does not already exist.
-createDirectory :: FilePath -> Action ()
-createDirectory dir = do
- putProgressInfo $ "| Create directory " ++ dir
- liftIO $ IO.createDirectoryIfMissing True dir
-
--- | Copy a directory. The contents of the source directory is untracked.
-copyDirectory :: FilePath -> FilePath -> Action ()
-copyDirectory source target = do
- putProgressInfo =<< renderAction "Copy directory" source target
- quietly $ cmd ["cp", "-r", source, target]
-
--- | Move a directory. The contents of the source directory is untracked.
-moveDirectory :: FilePath -> FilePath -> Action ()
-moveDirectory source target = do
- putProgressInfo =<< renderAction "Move directory" source target
- quietly $ cmd ["mv", source, target]
-
--- | Remove a directory that doesn't necessarily exist.
-removeDirectory :: FilePath -> Action ()
-removeDirectory dir = do
- putProgressInfo $ "| Remove directory " ++ dir
- liftIO . whenM (IO.doesDirectoryExist dir) $ IO.removeDirectoryRecursive dir
-
-data UseColour = Never | Auto | Always deriving (Eq, Show, Typeable)
-
--- | A more colourful version of Shake's 'putNormal'.
-putColoured :: ColorIntensity -> Color -> String -> Action ()
-putColoured intensity colour msg = do
- useColour <- userSetting Never
- supported <- liftIO $ hSupportsANSI IO.stdout
- let c Never = False
- c Auto = supported || IO.isWindows -- Colours do work on Windows
- c Always = True
- when (c useColour) . liftIO $ setSGR [SetColor Foreground intensity colour]
- putNormal msg
- when (c useColour) . liftIO $ setSGR [] >> IO.hFlush IO.stdout
-
-newtype BuildProgressColour = BuildProgressColour (ColorIntensity, Color)
- deriving Typeable
-
--- | Default 'BuildProgressColour'.
-magenta :: BuildProgressColour
-magenta = BuildProgressColour (Dull, Magenta)
-
--- | Print a build progress message (e.g. executing a build command).
-putBuild :: String -> Action ()
-putBuild msg = do
- BuildProgressColour (intensity, colour) <- userSetting magenta
- putColoured intensity colour msg
-
-newtype SuccessColour = SuccessColour (ColorIntensity, Color)
- deriving Typeable
-
--- | Default 'SuccessColour'.
-green :: SuccessColour
-green = SuccessColour (Dull, Green)
-
--- | Print a success message (e.g. a package is built successfully).
-putSuccess :: String -> Action ()
-putSuccess msg = do
- SuccessColour (intensity, colour) <- userSetting green
- putColoured intensity colour msg
-
-data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show, Typeable)
-
--- | Version of 'putBuild' controlled by @--progress-info@ command line argument.
-putProgressInfo :: String -> Action ()
-putProgressInfo msg = do
- progressInfo <- userSetting None
- when (progressInfo /= None) $ putBuild msg
-
--- | Render an action.
-renderAction :: String -> FilePath -> FilePath -> Action String
-renderAction what input output = do
- progressInfo <- userSetting Brief
- return $ case progressInfo of
- None -> ""
- Brief -> "| " ++ what ++ ": " ++ i ++ " => " ++ o
- Normal -> renderBox [ what, " input: " ++ i, " => output: " ++ o ]
- Unicorn -> renderUnicorn [ what, " input: " ++ i, " => output: " ++ o ]
- where
- i = unifyPath input
- o = unifyPath output
-
--- | Render the successful build of a program.
-renderProgram :: String -> String -> Maybe String -> String
-renderProgram name bin synopsis = renderBox $
- [ "Successfully built program " ++ name
- , "Executable: " ++ bin ] ++
- [ "Program synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
-
--- | Render the successful build of a library.
-renderLibrary :: String -> String -> Maybe String -> String
-renderLibrary name lib synopsis = renderBox $
- [ "Successfully built library " ++ name
- , "Library: " ++ lib ] ++
- [ "Library synopsis: " ++ prettySynopsis synopsis | isJust synopsis ]
-
-prettySynopsis :: Maybe String -> String
-prettySynopsis Nothing = ""
-prettySynopsis (Just s) = dropWhileEnd isPunctuation s ++ "."
-
--- | Render the given set of lines in an ASCII box. The minimum width and
--- whether to use Unicode symbols are hardcoded in the function's body.
---
--- >>> renderBox (words "lorem ipsum")
--- /----------\
--- | lorem |
--- | ipsum |
--- \----------/
-renderBox :: [String] -> String
-renderBox ls = tail $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot])
- where
- -- Minimum total width of the box in characters
- minimumBoxWidth = 32
-
- -- TODO: Make this setting configurable? Setting to True by default seems
- -- to work poorly with many fonts.
- useUnicode = False
-
- -- Characters to draw the box
- (dash, pipe, topLeft, topRight, botLeft, botRight, padding)
- | useUnicode = ('─', '│', '╭', '╮', '╰', '╯', ' ')
- | otherwise = ('-', '|', '/', '\\', '\\', '/', ' ')
-
- -- Box width, taking minimum desired length and content into account.
- -- The -4 is for the beginning and end pipe/padding symbols, as
- -- in "| xxx |".
- boxContentWidth = (minimumBoxWidth - 4) `max` maxContentLength
- where
- maxContentLength = maximum (map length ls)
-
- renderLine l = concat
- [ [pipe, padding]
- , padToLengthWith boxContentWidth padding l
- , [padding, pipe] ]
- where
- padToLengthWith n filler x = x ++ replicate (n - length x) filler
-
- (boxTop, boxBot) = ( topLeft : dashes ++ [topRight]
- , botLeft : dashes ++ [botRight] )
- where
- -- +1 for each non-dash (= corner) char
- dashes = replicate (boxContentWidth + 2) dash
-
--- | Render the given set of lines next to our favorite unicorn Robert.
-renderUnicorn :: [String] -> String
-renderUnicorn ls =
- unlines $ take (max (length ponyLines) (length boxLines)) $
- zipWith (++) (ponyLines ++ repeat ponyPadding) (boxLines ++ repeat "")
- where
- ponyLines :: [String]
- ponyLines = [ " ,;,,;'"
- , " ,;;'( Robert the spitting unicorn"
- , " __ ,;;' ' \\ wants you to know"
- , " /' '\\'~~'~' \\ /'\\.) that a task "
- , " ,;( ) / |. / just finished! "
- , " ,;' \\ /-.,,( ) \\ "
- , " ^ ) / ) / )| Almost there! "
- , " || || \\) "
- , " (_\\ (_\\ " ]
- ponyPadding :: String
- ponyPadding = " "
- boxLines :: [String]
- boxLines = ["", "", ""] ++ (lines . renderBox $ ls)
diff --git a/hadrian/src/Main.hs b/hadrian/src/Main.hs
deleted file mode 100644
index 52af0adf7c..0000000000
--- a/hadrian/src/Main.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-module Main (main) where
-
-import Development.Shake
-import Hadrian.Expression
-import Hadrian.Utilities
-
-import qualified Base
-import qualified CommandLine
-import qualified Environment
-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 UserSettings
-
-main :: IO ()
-main = do
- -- Provide access to command line arguments and some user settings through
- -- Shake's type-indexed map 'shakeExtra'.
- argsMap <- CommandLine.cmdLineArgsMap
- let extra = insertExtra UserSettings.buildProgressColour
- $ insertExtra UserSettings.successColour
- $ insertExtra UserSettings.userBuildRoot
- $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap
-
- BuildRoot buildRoot = UserSettings.userBuildRoot
-
- rebuild = [ (RebuildLater, buildRoot -/- "stage0//*")
- | CommandLine.lookupFreeze1 argsMap ]
-
- options :: ShakeOptions
- options = shakeOptions
- { shakeChange = ChangeModtimeAndDigest
- , shakeFiles = buildRoot -/- Base.shakeFilesDir
- , shakeProgress = progressSimple
- , shakeRebuild = rebuild
- , shakeTimings = True
- , shakeExtra = extra }
-
- rules :: Rules ()
- rules = do
- Rules.buildRules
- Rules.Documentation.documentationRules
- Rules.Clean.cleanRules
- Rules.Install.installRules
- Rules.oracleRules
- Rules.Selftest.selftestRules
- Rules.SourceDist.sourceDistRules
- Rules.Test.testRules
- Rules.topLevelTargets
-
- shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
- Environment.setupEnvironment
- return . Just $ if null targets
- then rules
- else want targets >> withoutActions rules
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs
deleted file mode 100644
index 1bd4dfeefd..0000000000
--- a/hadrian/src/Oracles/Flag.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-module Oracles.Flag (
- Flag (..), flag, crossCompiling, platformSupportsSharedLibs,
- ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
- ) where
-
-import Hadrian.Oracles.TextFile
-
-import Base
-import Oracles.Setting
-
-data Flag = ArSupportsAtFile
- | CrossCompiling
- | GccIsClang
- | GhcUnregisterised
- | LeadingUnderscore
- | SolarisBrokenShld
- | SplitObjectsBroken
- | WithLibdw
- | HaveLibMingwEx
- | UseSystemFfi
-
--- Note, if a flag is set to empty string we treat it as set to NO. This seems
--- fragile, but some flags do behave like this, e.g. GccIsClang.
-flag :: Flag -> Action Bool
-flag f = do
- let key = case f of
- ArSupportsAtFile -> "ar-supports-at-file"
- CrossCompiling -> "cross-compiling"
- GccIsClang -> "gcc-is-clang"
- GhcUnregisterised -> "ghc-unregisterised"
- LeadingUnderscore -> "leading-underscore"
- SolarisBrokenShld -> "solaris-broken-shld"
- SplitObjectsBroken -> "split-objects-broken"
- WithLibdw -> "with-libdw"
- HaveLibMingwEx -> "have-lib-mingw-ex"
- UseSystemFfi -> "use-system-ffi"
- value <- lookupValueOrError configFile key
- when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
- ++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
- return $ value == "YES"
-
-crossCompiling :: Action Bool
-crossCompiling = flag CrossCompiling
-
-platformSupportsSharedLibs :: Action Bool
-platformSupportsSharedLibs = do
- badPlatform <- anyTargetPlatform [ "powerpc-unknown-linux"
- , "x86_64-unknown-mingw32"
- , "i386-unknown-mingw32" ]
- solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ]
- solarisBroken <- flag SolarisBrokenShld
- return $ not (badPlatform || solaris && solarisBroken)
-
-ghcWithSMP :: Action Bool
-ghcWithSMP = do
- goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "arm"]
- ghcUnreg <- flag GhcUnregisterised
- return $ goodArch && not ghcUnreg
-
-ghcWithNativeCodeGen :: Action Bool
-ghcWithNativeCodeGen = do
- goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc"]
- badOs <- anyTargetOs ["ios", "aix"]
- ghcUnreg <- flag GhcUnregisterised
- return $ goodArch && not badOs && not ghcUnreg
-
-supportsSplitObjects :: Action Bool
-supportsSplitObjects = do
- broken <- flag SplitObjectsBroken
- ghcUnreg <- flag GhcUnregisterised
- goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc" ]
- goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "darwin", "solaris2"
- , "freebsd", "dragonfly", "netbsd", "openbsd" ]
- return $ not broken && not ghcUnreg && goodArch && goodOs
diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs
deleted file mode 100644
index c7175dbc1c..0000000000
--- a/hadrian/src/Oracles/ModuleFiles.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-module Oracles.ModuleFiles (
- decodeModule, encodeModule, findGenerator, hsSources, hsObjects, moduleFilesOracle
- ) where
-
-import qualified Data.HashMap.Strict as Map
-
-import Base
-import Builder
-import Context
-import GHC
-import Oracles.PackageData
-
-newtype ModuleFiles = ModuleFiles (Stage, Package)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult ModuleFiles = [Maybe FilePath]
-
-newtype Generator = Generator (Stage, Package, FilePath)
- deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult Generator = Maybe FilePath
-
--- | We scan for the following Haskell source extensions when looking for module
--- files. Note, we do not list "*.(l)hs-boot" files here, as they can never
--- appear by themselves and always have accompanying "*.(l)hs" master files.
-haskellExtensions :: [String]
-haskellExtensions = [".hs", ".lhs"]
-
--- | Non-Haskell source extensions and corresponding builders.
-otherExtensions :: [(String, Builder)]
-otherExtensions = [ (".x" , Alex )
- , (".y" , Happy )
- , (".ly" , Happy )
- , (".hsc", Hsc2Hs) ]
-
--- | We match the following file patterns when looking for module files.
-moduleFilePatterns :: [FilePattern]
-moduleFilePatterns = map ("*" ++) $ haskellExtensions ++ map fst otherExtensions
-
--- | Given a FilePath determine the corresponding builder.
-determineBuilder :: FilePath -> Maybe Builder
-determineBuilder file = lookup (takeExtension file) otherExtensions
-
--- | Given a module name extract the directory and file name, e.g.:
---
--- > decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
--- > decodeModule "Prelude" == ("", "Prelude")
-decodeModule :: String -> (FilePath, String)
-decodeModule modName = (intercalate "/" (init xs), last xs)
- where
- xs = words $ replaceEq '.' ' ' modName
-
--- | Given the directory and file name find the corresponding module name, e.g.:
---
--- > encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
--- > encodeModule "" "Prelude" == "Prelude"
--- > uncurry encodeModule (decodeModule name) == name
-encodeModule :: FilePath -> String -> String
-encodeModule dir file
- | dir == "" = takeBaseName file
- | otherwise = replaceEq '/' '.' dir ++ '.' : takeBaseName file
-
--- | Find the generator for a given 'Context' and a source file. For example:
--- findGenerator (Context Stage1 compiler vanilla)
--- "_build/stage1/compiler/build/Lexer.hs"
--- == Just ("compiler/parser/Lexer.x", Alex)
--- findGenerator (Context Stage1 base vanilla)
--- "_build/stage1/base/build/Prelude.hs"
--- == Nothing
-findGenerator :: Context -> FilePath -> Action (Maybe (FilePath, Builder))
-findGenerator Context {..} file = do
- maybeSource <- askOracle $ Generator (stage, package, file)
- return $ do
- source <- maybeSource
- builder <- determineBuilder source
- return (source, builder)
-
--- | Find all Haskell source files for a given 'Context'.
-hsSources :: Context -> Action [FilePath]
-hsSources context = do
- let modFile (m, Nothing ) = generatedFile context m
- modFile (m, Just file )
- | takeExtension file `elem` haskellExtensions = return file
- | otherwise = generatedFile context m
- mapM modFile =<< contextFiles context
-
--- | Find all Haskell object files for a given 'Context'. Note: this is a much
--- simpler function compared to 'hsSources', because all object files live in
--- the build directory regardless of whether they are generated or not.
-hsObjects :: Context -> Action [FilePath]
-hsObjects context = do
- 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)
-
--- | Generated module files live in the 'Context' specific build directory.
-generatedFile :: Context -> String -> Action FilePath
-generatedFile context moduleName = do
- path <- buildPath context
- return $ path -/- moduleSource moduleName
-
-moduleSource :: String -> FilePath
-moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
-
--- | 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
- zip modules <$> askOracle (ModuleFiles (stage, package))
-
--- | This is an important oracle whose role is to find and cache module source
--- files. It takes a 'Stage' and a 'Package', looks up corresponding source
--- directories @dirs@ and a sorted list of module names @modules@, and for each
--- module, e.g. @A.B.C@, returns a 'FilePath' of the form @dir/A/B/C.extension@,
--- such that @dir@ belongs to @dirs@, and file @dir/A/B/C.extension@ exists, or
--- 'Nothing' if there is no such file. If more than one matching file is found
--- an error is raised. For example, for 'Stage1' and 'compiler', @dirs@ will
--- contain ["compiler/codeGen", "compiler/parser"], and @modules@ will contain
--- ["CodeGen.Platform.ARM", "Config", "Lexer"]; the oracle will produce a list
--- containing [Just "compiler/codeGen/CodeGen/Platform/ARM.hs", Nothing,
--- Just "compiler/parser/Lexer.x"]. The oracle ignores @.(l)hs-boot@ files.
-moduleFilesOracle :: Rules ()
-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
- autogen <- autogenPath context
- let dirs = autogen : map (pkgPath package -/-) srcDirs
- modDirFiles = groupSort $ map decodeModule modules
- result <- concatForM dirs $ \dir -> do
- todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
- forM todo $ \(mDir, mFiles) -> do
- let fullDir = unifyPath $ dir -/- mDir
- files <- getDirectoryFiles fullDir moduleFilePatterns
- let cmp f = compare (dropExtension f)
- found = intersectOrd cmp files mFiles
- return (map (fullDir -/-) found, mDir)
- let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
- multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]
- unless (null multi) $ do
- let (m, f1, f2) = head multi
- error $ "Module " ++ m ++ " has more than one source file: "
- ++ f1 ++ " and " ++ f2 ++ "."
- return $ lookupAll modules pairs
-
- -- Optimisation: we discard Haskell files here, because they are never used
- -- as generators, and hence would be discarded in 'findGenerator' anyway.
- generators <- newCache $ \(stage, package) -> do
- let context = vanillaContext stage package
- files <- contextFiles context
- list <- sequence [ (,src) <$> generatedFile context modName
- | (modName, Just src) <- files
- , takeExtension src `notElem` haskellExtensions ]
- return $ Map.fromList list
-
- addOracle $ \(Generator (stage, package, file)) ->
- Map.lookup file <$> generators (stage, package)
diff --git a/hadrian/src/Oracles/PackageData.hs b/hadrian/src/Oracles/PackageData.hs
deleted file mode 100644
index cdfe9bfb48..0000000000
--- a/hadrian/src/Oracles/PackageData.hs
+++ /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 (== '\'')
diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs
deleted file mode 100644
index aa49011e1e..0000000000
--- a/hadrian/src/Oracles/Setting.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-module Oracles.Setting (
- configFile, Setting (..), SettingList (..), setting, settingList, getSetting,
- getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
- ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
- ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
- topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf
- ) where
-
-import Hadrian.Expression
-import Hadrian.Oracles.TextFile
-import Hadrian.Oracles.Path
-
-import Base
-
--- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
--- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
--- @setting TargetOs@ looks up the config file and returns "mingw32".
--- 'SettingList' is used for multiple string values separated by spaces, such
--- as @gmp-include-dirs = a b@.
--- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
-data Setting = BuildArch
- | BuildOs
- | BuildPlatform
- | BuildVendor
- | CcClangBackend
- | CcLlvmBackend
- | DynamicExtension
- | GhcMajorVersion
- | GhcMinorVersion
- | GhcPatchLevel
- | GhcVersion
- | GhcSourcePath
- | HostArch
- | HostOs
- | HostPlatform
- | HostVendor
- | ProjectGitCommitId
- | ProjectName
- | ProjectVersion
- | ProjectVersionInt
- | ProjectPatchLevel
- | ProjectPatchLevel1
- | ProjectPatchLevel2
- | TargetArch
- | TargetOs
- | TargetPlatform
- | TargetPlatformFull
- | TargetVendor
- | LlvmTarget
- | FfiIncludeDir
- | FfiLibDir
- | GmpIncludeDir
- | GmpLibDir
- | IconvIncludeDir
- | IconvLibDir
- | CursesLibDir
- -- Paths to where GHC is installed (ref: mk/install.mk)
- | InstallPrefix
- | InstallBinDir
- | InstallLibDir
- | InstallDataRootDir
- -- Command lines for invoking the @install@ utility
- | Install
- | InstallData
- | InstallProgram
- | InstallScript
- | InstallDir
- -- Command line for creating a symbolic link
- | LnS
-
-data SettingList = ConfCcArgs Stage
- | ConfCppArgs Stage
- | ConfGccLinkerArgs Stage
- | ConfLdLinkerArgs Stage
- | HsCppArgs
-
--- | Maps 'Setting's to names in @cfg/system.config.in@.
-setting :: Setting -> Action String
-setting key = lookupValueOrError configFile $ case key of
- BuildArch -> "build-arch"
- BuildOs -> "build-os"
- BuildPlatform -> "build-platform"
- BuildVendor -> "build-vendor"
- CcClangBackend -> "cc-clang-backend"
- CcLlvmBackend -> "cc-llvm-backend"
- DynamicExtension -> "dynamic-extension"
- GhcMajorVersion -> "ghc-major-version"
- GhcMinorVersion -> "ghc-minor-version"
- GhcPatchLevel -> "ghc-patch-level"
- GhcVersion -> "ghc-version"
- GhcSourcePath -> "ghc-source-path"
- HostArch -> "host-arch"
- HostOs -> "host-os"
- HostPlatform -> "host-platform"
- HostVendor -> "host-vendor"
- ProjectGitCommitId -> "project-git-commit-id"
- ProjectName -> "project-name"
- ProjectVersion -> "project-version"
- ProjectVersionInt -> "project-version-int"
- ProjectPatchLevel -> "project-patch-level"
- ProjectPatchLevel1 -> "project-patch-level1"
- ProjectPatchLevel2 -> "project-patch-level2"
- TargetArch -> "target-arch"
- TargetOs -> "target-os"
- TargetPlatform -> "target-platform"
- TargetPlatformFull -> "target-platform-full"
- TargetVendor -> "target-vendor"
- LlvmTarget -> "llvm-target"
- FfiIncludeDir -> "ffi-include-dir"
- FfiLibDir -> "ffi-lib-dir"
- GmpIncludeDir -> "gmp-include-dir"
- GmpLibDir -> "gmp-lib-dir"
- IconvIncludeDir -> "iconv-include-dir"
- IconvLibDir -> "iconv-lib-dir"
- CursesLibDir -> "curses-lib-dir"
- InstallPrefix -> "install-prefix"
- InstallBinDir -> "install-bindir"
- InstallLibDir -> "install-libdir"
- InstallDataRootDir -> "install-datarootdir"
- Install -> "install"
- InstallDir -> "install-dir"
- InstallProgram -> "install-program"
- InstallScript -> "install-script"
- InstallData -> "install-data"
- LnS -> "ln-s"
-
-settingList :: SettingList -> Action [String]
-settingList key = fmap words $ lookupValueOrError configFile $ case key of
- ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage
- ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage
- ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage
- ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage
- HsCppArgs -> "hs-cpp-args"
-
--- | Get a configuration setting.
-getSetting :: Setting -> Expr c b String
-getSetting = expr . setting
-
--- | Get a list of configuration settings.
-getSettingList :: SettingList -> Args c b
-getSettingList = expr . settingList
-
-matchSetting :: Setting -> [String] -> Action Bool
-matchSetting key values = (`elem` values) <$> setting key
-
-anyTargetPlatform :: [String] -> Action Bool
-anyTargetPlatform = matchSetting TargetPlatformFull
-
-anyTargetOs :: [String] -> Action Bool
-anyTargetOs = matchSetting TargetOs
-
-anyTargetArch :: [String] -> Action Bool
-anyTargetArch = matchSetting TargetArch
-
-anyHostOs :: [String] -> Action Bool
-anyHostOs = matchSetting HostOs
-
-iosHost :: Action Bool
-iosHost = anyHostOs ["ios"]
-
-osxHost :: Action Bool
-osxHost = anyHostOs ["darwin"]
-
-windowsHost :: Action Bool
-windowsHost = anyHostOs ["mingw32", "cygwin32"]
-
-ghcWithInterpreter :: Action Bool
-ghcWithInterpreter = do
- goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
- , "freebsd", "dragonfly", "netbsd", "openbsd"
- , "darwin", "kfreebsdgnu" ]
- goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc"
- , "sparc64", "arm" ]
- return $ goodOs && goodArch
-
-ghcEnableTablesNextToCode :: Action Bool
-ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]
-
-useLibFFIForAdjustors :: Action Bool
-useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
-
--- | Canonicalised GHC version number, used for integer version comparisons. We
--- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
-ghcCanonVersion :: Action String
-ghcCanonVersion = do
- ghcMajorVersion <- setting GhcMajorVersion
- ghcMinorVersion <- setting GhcMinorVersion
- let leadingZero = [ '0' | length ghcMinorVersion == 1 ]
- return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion
-
--- ref: https://ghc.haskell.org/trac/ghc/wiki/Building/Installing#HowGHCfindsitsfiles
--- | On Windows we normally build a relocatable installation, which assumes that
--- the library directory @libdir@ is in a fixed location relative to the GHC
--- binary, namely @../lib@.
-relocatableBuild :: Action Bool
-relocatableBuild = windowsHost
-
-installDocDir :: Action String
-installDocDir = do
- version <- setting ProjectVersion
- dataDir <- setting InstallDataRootDir
- return $ dataDir -/- ("doc/ghc-" ++ version)
-
--- | Path to the GHC source tree.
-topDirectory :: Action FilePath
-topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
-
--- ref: mk/install.mk:101
--- TODO: CroosCompilePrefix
--- | Unix: override @libdir@ and @datadir@ to put GHC-specific files in a
--- subdirectory with the version number included.
-installGhcLibDir :: Action String
-installGhcLibDir = do
- rBuild <- relocatableBuild
- libdir <- setting InstallLibDir
- if rBuild then return libdir
- else do
- version <- setting ProjectVersion
- return $ libdir -/- ("ghc-" ++ version)
-
--- TODO: find out why we need version number in the dynamic suffix
--- The current theory: dynamic libraries are eventually placed in a single
--- giant directory in the load path of the dynamic linker, and hence we must
--- distinguish different versions of GHC. In contrast static libraries live
--- in their own per-package directory and hence do not need a unique filename.
--- We also need to respect the system's dynamic extension, e.g. .dll or .so.
-libsuf :: Way -> Action String
-libsuf way =
- if not (wayUnit Dynamic way)
- then return $ waySuffix way ++ ".a" -- e.g., _p.a
- else do
- extension <- setting DynamicExtension -- e.g., .dll or .so
- version <- setting ProjectVersion -- e.g., 7.11.20141222
- let prefix = wayPrefix $ removeWayUnit Dynamic way
- -- e.g., p_ghc7.11.20141222.dll (the result)
- return $ prefix ++ "-ghc" ++ version ++ extension
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
deleted file mode 100644
index d5c26e8e94..0000000000
--- a/hadrian/src/Rules.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
-
-import qualified Hadrian.Oracles.ArgsHash
-import qualified Hadrian.Oracles.DirectoryContents
-import qualified Hadrian.Oracles.Path
-import qualified Hadrian.Oracles.TextFile
-
-import Expression
-import qualified Oracles.ModuleFiles
-import qualified Rules.Compile
-import qualified Rules.PackageData
-import qualified Rules.Dependencies
-import qualified Rules.Documentation
-import qualified Rules.Generate
-import qualified Rules.Configure
-import qualified Rules.Gmp
-import qualified Rules.Libffi
-import qualified Rules.Library
-import qualified Rules.Program
-import qualified Rules.Register
-import Settings
-import Target
-import UserSettings
-import Utilities
-
-allStages :: [Stage]
-allStages = [minBound ..]
-
--- | 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
-
--- 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
--- GHCi library needs to be built for this package. We typically want to set
--- this parameter to True, however it is important to set it to False when
--- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
--- because we need to run @ghc-cabal@ in the order respecting package dependencies.
-packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
-packageTargets includeGhciLib stage pkg = do
- let context = vanillaContext stage pkg
- activePackages <- stagePackages stage
- if pkg `notElem` activePackages
- then return [] -- Skip inactive packages.
- else if isLibrary pkg
- then do -- Collect all targets of a library package.
- let pkgWays = if pkg == rts then getRtsWays else getLibraryWays
- ways <- interpretInContext context pkgWays
- libs <- mapM (pkgLibraryFile . Context stage pkg) ways
- more <- libraryTargets includeGhciLib context
- setup <- pkgSetupConfigFile context
- return $ [ setup | not (nonCabalContext context) ] ++ libs ++ more
- else do -- The only target of a program package is the executable.
- prgContext <- programContext stage pkg
- prgPath <- programPath prgContext
- return [prgPath]
-
-packageRules :: Rules ()
-packageRules = do
- -- We cannot register multiple GHC packages in parallel. Also we cannot run
- -- GHC when the package database is being mutated by "ghc-pkg". This is a
- -- classic concurrent read exclusive write (CREW) conflict.
- let maxConcurrentReaders = 1000
- packageDb <- newResource "package-db" maxConcurrentReaders
- let readPackageDb = [(packageDb, 1)]
- writePackageDb = [(packageDb, maxConcurrentReaders)]
-
- let contexts = liftM3 Context allStages knownPackages allWays
- vanillaContexts = liftM2 vanillaContext allStages knownPackages
-
- forM_ contexts $ mconcat
- [ Rules.Compile.compilePackage readPackageDb
- , Rules.Library.buildPackageLibrary ]
-
- let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
- forM_ dynamicContexts Rules.Library.buildDynamicLib
-
- forM_ (filter isProgram knownPackages) $
- Rules.Program.buildProgram readPackageDb
-
- forM_ vanillaContexts $ mconcat
- [ Rules.PackageData.buildPackageData
- , Rules.Dependencies.buildPackageDependencies readPackageDb
- , Rules.Documentation.buildPackageDocumentation
- , Rules.Library.buildPackageGhciLibrary
- , Rules.Generate.generatePackageCode
- , Rules.Register.registerPackage writePackageDb ]
-
-buildRules :: Rules ()
-buildRules = do
- Rules.Configure.configureRules
- Rules.Generate.copyRules
- Rules.Generate.generateRules
- Rules.Gmp.gmpRules
- Rules.Libffi.libffiRules
- packageRules
-
-oracleRules :: Rules ()
-oracleRules = do
- Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
- Hadrian.Oracles.DirectoryContents.directoryContentsOracle
- Hadrian.Oracles.Path.pathOracle
- Hadrian.Oracles.TextFile.textFileOracle
- Oracles.ModuleFiles.moduleFilesOracle
-
-programsStage1Only :: [Package]
-programsStage1Only = [ deriveConstants, genapply, genprimopcode, ghc, ghcCabal
- , ghcPkg, hp2ps, hpc, hsc2hs, runGhc ]
diff --git a/hadrian/src/Rules/Clean.hs b/hadrian/src/Rules/Clean.hs
deleted file mode 100644
index d11cbf5e53..0000000000
--- a/hadrian/src/Rules/Clean.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Rules.Clean (clean, cleanSourceTree, cleanRules) where
-
-import Base
-
-clean :: Action ()
-clean = do
- cleanSourceTree
- putBuild "| Remove Hadrian files..."
- path <- buildRoot
- removeDirectory $ path -/- generatedDir
- removeFilesAfter path ["//*"]
- putSuccess "| Done. "
-
-cleanSourceTree :: Action ()
-cleanSourceTree = do
- path <- buildRoot
- forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString
- removeDirectory inplaceBinPath
- removeDirectory inplaceLibPath
- removeDirectory "sdistprep"
-
-cleanRules :: Rules ()
-cleanRules = "clean" ~> clean
diff --git a/hadrian/src/Rules/Compile.hs b/hadrian/src/Rules/Compile.hs
deleted file mode 100644
index b7f3bc8447..0000000000
--- a/hadrian/src/Rules/Compile.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-module Rules.Compile (compilePackage) where
-
-import Hadrian.Oracles.TextFile
-
-import Base
-import Context
-import Expression
-import Rules.Generate
-import Target
-import Utilities
-
-compilePackage :: [(Resource, Int)] -> Context -> Rules ()
-compilePackage rs context@Context {..} = do
- let dir = "//" ++ contextDir context
- nonHs extension = dir -/- extension <//> "*" <.> osuf way
- compile compiler obj2src obj = do
- src <- obj2src context obj
- need [src]
- needDependencies context src $ obj <.> "d"
- buildWithResources rs $ target context (compiler stage) [src] [obj]
- compileHs = \[obj, _hi] -> do
- path <- buildPath context
- (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
- need $ src : deps
- buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
-
- priority 2.0 $ do
- nonHs "c" %> compile (Ghc CompileCWithGhc) (obj2src "c" isGeneratedCFile )
- nonHs "cmm" %> compile (Ghc CompileHs) (obj2src "cmm" isGeneratedCmmFile)
- nonHs "s" %> compile (Ghc CompileHs) (obj2src "S" $ const False )
-
- -- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
- [ dir <//> "*" <.> suf way | suf <- [ osuf, hisuf] ] &%> compileHs
- [ dir <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
-
--- | Discover dependencies of a given source file by iteratively calling @gcc@
--- in the @-MM -MG@ mode and building generated dependencies if they are missing
--- until reaching a fixed point.
-needDependencies :: Context -> FilePath -> FilePath -> Action ()
-needDependencies context@Context {..} src depFile = discover
- where
- discover = do
- build $ target context (Cc FindCDependencies stage) [src] [depFile]
- deps <- parseFile depFile
- -- Generated dependencies, if not yet built, will not be found and hence
- -- will be referred to simply by their file names.
- let notFound = filter (\file -> file == takeFileName file) deps
- -- We find the full paths to generated dependencies, so we can request
- -- to build them by calling 'need'.
- todo <- catMaybes <$> mapM (fullPathIfGenerated context) notFound
-
- if null todo
- then need deps -- The list of dependencies is final, need all
- else do
- need todo -- Build newly discovered generated dependencies
- discover -- Continue the discovery process
-
- parseFile :: FilePath -> Action [String]
- parseFile file = do
- input <- liftIO $ readFile file
- case parseMakefile input of
- [(_file, deps)] -> return deps
- _ -> return []
-
--- | Find a given 'FilePath' in the list of generated files in the given
--- 'Context' and return its full path.
-fullPathIfGenerated :: Context -> FilePath -> Action (Maybe FilePath)
-fullPathIfGenerated context file = interpretInContext context $ do
- generated <- generatedDependencies
- return $ find ((== file) . takeFileName) generated
-
-obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> Action FilePath
-obj2src extension isGenerated context@Context {..} obj
- | isGenerated src = return src
- | otherwise = (pkgPath package ++) <$> suffix
- where
- src = obj -<.> extension
- suffix = do
- path <- buildPath context
- return $ fromMaybe ("Cannot determine source for " ++ obj)
- $ stripPrefix (path -/- extension) src
diff --git a/hadrian/src/Rules/Configure.hs b/hadrian/src/Rules/Configure.hs
deleted file mode 100644
index 9de31e2bbc..0000000000
--- a/hadrian/src/Rules/Configure.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Rules.Configure (configureRules) where
-
-import qualified System.Info.Extra as System
-
-import Base
-import Builder
-import CommandLine
-import Context
-import GHC
-import Target
-import Utilities
-
-configureRules :: Rules ()
-configureRules = do
- [configFile, "settings", configH] &%> \outs -> do
- skip <- not <$> cmdConfigure
- if skip
- then unlessM (doesFileExist configFile) $
- error $ "Configuration file " ++ configFile ++ " is missing.\n"
- ++ "Run the configure script manually or let Hadrian run it "
- ++ "automatically by passing the flag --configure."
- else do
- -- We cannot use windowsHost here due to a cyclic dependency.
- when System.isWindows $ do
- putBuild "| Checking for Windows tarballs..."
- quietly $ cmd ["bash", "mk/get-win32-tarballs.sh", "download", System.arch]
- let srcs = map (<.> "in") outs
- context = vanillaContext Stage0 compiler
- need srcs
- build $ target context (Configure ".") srcs outs
-
- ["configure", configH <.> "in"] &%> \_ -> do
- skip <- not <$> cmdConfigure
- if skip
- then unlessM (doesFileExist "configure") $
- error $ "The configure script is missing.\nRun the boot script "
- ++ "manually let Hadrian run it automatically by passing the "
- ++ "flag --configure."
- else do
- need ["configure.ac"]
- putBuild "| Running boot..."
- verbosity <- getVerbosity
- quietly $ cmd [EchoStdout (verbosity >= Loud)] "python3 boot"
diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
deleted file mode 100644
index f9d17e93d8..0000000000
--- a/hadrian/src/Rules/Dependencies.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Rules.Dependencies (buildPackageDependencies) where
-
-import Data.Bifunctor
-import Data.Function
-
-import Base
-import Context
-import Expression
-import Oracles.ModuleFiles
-import Rules.Generate
-import Target
-import Utilities
-
-buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
-buildPackageDependencies rs context@Context {..} =
- "//" ++ contextDir context -/- ".dependencies" %> \deps -> do
- srcs <- hsSources context
- need srcs
- orderOnly =<< interpretInContext context generatedDependencies
- let mk = deps <.> "mk"
- if null srcs
- then writeFile' mk ""
- else buildWithResources rs $
- target context (Ghc FindHsDependencies stage) srcs [mk]
- removeFile $ mk <.> "bak"
- mkDeps <- liftIO $ readFile mk
- writeFileChanged deps . unlines
- . map (\(src, deps) -> unwords $ src : deps)
- . map (bimap unifyPath (map unifyPath))
- . map (bimap head concat . unzip)
- . groupBy ((==) `on` fst)
- . sortBy (compare `on` fst)
- $ parseMakefile mkDeps
diff --git a/hadrian/src/Rules/Documentation.hs b/hadrian/src/Rules/Documentation.hs
deleted file mode 100644
index 5a5698c995..0000000000
--- a/hadrian/src/Rules/Documentation.hs
+++ /dev/null
@@ -1,197 +0,0 @@
-module Rules.Documentation (
- -- * Rules
- buildPackageDocumentation, documentationRules,
-
- -- * Utilities
- haddockDependencies
- ) where
-
-import Base
-import Context
-import Flavour
-import GHC
-import Oracles.ModuleFiles
-import Oracles.PackageData
-import Settings
-import Target
-import Utilities
-
--- | Build all documentation
-documentationRules :: Rules ()
-documentationRules = do
- buildHtmlDocumentation
- buildPdfDocumentation
- buildDocumentationArchives
- buildManPage
- "//docs//gen_contents_index" %> copyFile "libraries/gen_contents_index"
- "//docs//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
- need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ]
- need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ]
- need [manPagePath]
-
-manPagePath :: FilePath
-manPagePath = "_build/docs/users_guide/build-man/ghc.1"
-
--- TODO: Add support for Documentation Packages so we can
--- run the builders without this hack.
-docPackage :: Package
-docPackage = hsLibrary "Documentation" "docs"
-
-docPaths :: [FilePath]
-docPaths = [ "libraries", "users_guide", "Haddock" ]
-
-docRoot :: FilePath
-docRoot = "docs"
-
-htmlRoot :: FilePath
-htmlRoot = docRoot -/- "html"
-
-pdfRoot :: FilePath
-pdfRoot = docRoot -/- "pdfs"
-
-archiveRoot :: FilePath
-archiveRoot = docRoot -/- "archives"
-
-pathPdf :: FilePath -> FilePath
-pathPdf path = pdfRoot -/- path <.> ".pdf"
-
-pathIndex :: FilePath -> FilePath
-pathIndex path = htmlRoot -/- path -/- "index.html"
-
-pathArchive :: FilePath -> FilePath
-pathArchive path = archiveRoot -/- path <.> "html.tar.xz"
-
--- TODO: Replace this with pkgPath when support is added
--- for Documentation Packages.
-pathPath :: FilePath -> FilePath
-pathPath "users_guide" = "docs/users_guide"
-pathPath "Haddock" = "utils/haddock/doc"
-pathPath _ = ""
-
-----------------------------------------------------------------------
--- HTML
-
--- | Build all HTML documentation
-buildHtmlDocumentation :: Rules ()
-buildHtmlDocumentation = do
- mapM_ buildSphinxHtml $ docPaths \\ [ "libraries" ]
- buildLibraryDocumentation
- "//" ++ htmlRoot -/- "index.html" %> \file -> do
- root <- buildRoot
- need $ map ((root -/-) . pathIndex) docPaths
- copyFileUntracked "docs/index.html" file
-
------------------------------
--- Sphinx
-
--- | Compile a Sphinx ReStructured Text package to HTML
-buildSphinxHtml :: FilePath -> Rules ()
-buildSphinxHtml path = do
- "//" ++ htmlRoot -/- path -/- "index.html" %> \file -> do
- let dest = takeDirectory file
- context = vanillaContext Stage0 docPackage
- build $ target context (Sphinx Html) [pathPath path] [dest]
-
------------------------------
--- Haddock
-
--- | Build the haddocks for GHC's libraries
-buildLibraryDocumentation :: Rules ()
-buildLibraryDocumentation = do
- "//" ++ htmlRoot -/- "libraries/index.html" %> \file -> do
- haddocks <- allHaddocks
- need haddocks
- let libDocs = filter (\x -> takeFileName x /= "ghc.haddock") haddocks
- context = vanillaContext Stage2 docPackage
- build $ target context (Haddock BuildIndex) libDocs [file]
-
-allHaddocks :: Action [FilePath]
-allHaddocks = do
- pkgs <- stagePackages Stage1
- sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
- | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
-
-haddockHtmlLib :: FilePath
-haddockHtmlLib = "inplace/lib/html/haddock-util.js"
-
--- | 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
- sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
- | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]
-
--- Note: this build rule creates plenty of files, not just the .haddock one.
--- All of them go into the 'doc' subdirectory. Pedantically tracking all built
--- files in the Shake database seems fragile and unnecessary.
-buildPackageDocumentation :: Context -> Rules ()
-buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do
-
- -- Js and Css files for haddock output
- when (package == haddock) $ haddockHtmlLib %> \_ -> do
- let dir = takeDirectory haddockHtmlLib
- liftIO $ removeFiles dir ["//*"]
- copyDirectory "utils/haddock/haddock-api/resources/html" dir
-
- -- Per-package haddocks
- "//" ++ pkgName package <.> "haddock" %> \file -> do
- haddocks <- haddockDependencies context
- srcs <- hsSources context
- need $ srcs ++ haddocks ++ [haddockHtmlLib]
-
- -- Build Haddock documentation
- -- TODO: pass the correct way from Rules via Context
- dynamicPrograms <- dynamicGhcPrograms <$> flavour
- let haddockWay = if dynamicPrograms then dynamic else vanilla
- build $ target (context {way = haddockWay}) (Haddock BuildPackage)
- srcs [file]
-
-----------------------------------------------------------------------
--- PDF
-
--- | Build all PDF documentation
-buildPdfDocumentation :: Rules ()
-buildPdfDocumentation = mapM_ buildSphinxPdf docPaths
-
--- | Compile a Sphinx ReStructured Text package to LaTeX
-buildSphinxPdf :: FilePath -> Rules ()
-buildSphinxPdf path = do
- "//" ++ path <.> "pdf" %> \file -> do
- let context = vanillaContext Stage0 docPackage
- withTempDir $ \dir -> do
- build $ target context (Sphinx Latex) [pathPath path] [dir]
- build $ target context Xelatex [path <.> "tex"] [dir]
- copyFileUntracked (dir -/- path <.> "pdf") file
-
-----------------------------------------------------------------------
--- Archive
-
--- | Build archives of documentation
-buildDocumentationArchives :: Rules ()
-buildDocumentationArchives = mapM_ buildArchive docPaths
-
-buildArchive :: FilePath -> Rules ()
-buildArchive path = do
- "//" ++ pathArchive path %> \file -> do
- root <- buildRoot
- let context = vanillaContext Stage0 docPackage
- src = root -/- pathIndex path
- need [src]
- build $ target context (Tar Create) [takeDirectory src] [file]
-
--- | build man page
-buildManPage :: Rules ()
-buildManPage = do
- manPagePath %> \file -> do
- need ["docs/users_guide/ghc.rst"]
- let context = vanillaContext Stage0 docPackage
- withTempDir $ \dir -> do
- build $ target context (Sphinx Man) ["docs/users_guide"] [dir]
- copyFileUntracked (dir -/- "ghc.1") file
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
deleted file mode 100644
index 8e2b65d183..0000000000
--- a/hadrian/src/Rules/Generate.hs
+++ /dev/null
@@ -1,482 +0,0 @@
-module Rules.Generate (
- isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
- copyRules, includesDependencies, generatedDependencies
- ) where
-
-import Base
-import Expression
-import Flavour
-import Oracles.Flag
-import Oracles.ModuleFiles
-import Oracles.Setting
-import Rules.Gmp
-import Rules.Libffi
-import Target
-import Settings
-import Settings.Packages.Rts
-import Utilities
-
--- | Track this file to rebuild generated files whenever it changes.
-trackGenerateHs :: Expr ()
-trackGenerateHs = expr $ need [sourcePath -/- "Rules/Generate.hs"]
-
-primopsSource :: FilePath
-primopsSource = "compiler/prelude/primops.txt.pp"
-
-primopsTxt :: Stage -> FilePath
-primopsTxt stage = contextDir (vanillaContext stage compiler) -/- "primops.txt"
-
-platformH :: Stage -> FilePath
-platformH stage = contextDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
-
-isGeneratedCFile :: FilePath -> Bool
-isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"]
-
-isGeneratedCmmFile :: FilePath -> Bool
-isGeneratedCmmFile file = takeBaseName file == "AutoApply"
-
-includesDependencies :: [FilePath]
-includesDependencies = fmap (generatedDir -/-)
- [ "ghcautoconf.h"
- , "ghcplatform.h"
- , "ghcversion.h" ]
-
-ghcPrimDependencies :: Expr [FilePath]
-ghcPrimDependencies = do
- stage <- getStage
- path <- expr $ buildPath (vanillaContext stage ghcPrim)
- return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
-
-derivedConstantsDependencies :: [FilePath]
-derivedConstantsDependencies = fmap (generatedDir -/-)
- [ "DerivedConstants.h"
- , "GHCConstantsHaskellExports.hs"
- , "GHCConstantsHaskellType.hs"
- , "GHCConstantsHaskellWrappers.hs" ]
-
-compilerDependencies :: Expr [FilePath]
-compilerDependencies = do
- root <- getBuildRoot
- stage <- getStage
- isGmp <- (== integerGmp) <$> getIntegerPackage
- ghcPath <- expr $ buildPath (vanillaContext stage compiler)
- gmpPath <- expr gmpBuildPath
- rtsPath <- expr rtsBuildPath
- mconcat [ return [root -/- platformH stage]
- , return ((root -/-) <$> includesDependencies)
- , return ((root -/-) <$> derivedConstantsDependencies)
- , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
- , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)
- , return $ fmap (ghcPath -/-)
- [ "primop-can-fail.hs-incl"
- , "primop-code-size.hs-incl"
- , "primop-commutable.hs-incl"
- , "primop-data-decl.hs-incl"
- , "primop-fixity.hs-incl"
- , "primop-has-side-effects.hs-incl"
- , "primop-list.hs-incl"
- , "primop-out-of-line.hs-incl"
- , "primop-primop-info.hs-incl"
- , "primop-strictness.hs-incl"
- , "primop-tag.hs-incl"
- , "primop-vector-tycons.hs-incl"
- , "primop-vector-tys-exports.hs-incl"
- , "primop-vector-tys.hs-incl"
- , "primop-vector-uniques.hs-incl" ] ]
-
-generatedDependencies :: Expr [FilePath]
-generatedDependencies = do
- root <- getBuildRoot
- rtsPath <- expr rtsBuildPath
- mconcat [ package compiler ? compilerDependencies
- , package ghcPrim ? ghcPrimDependencies
- , package rts ? return (fmap (rtsPath -/-) libffiDependencies
- ++ fmap (root -/-) includesDependencies
- ++ fmap (root -/-) derivedConstantsDependencies)
- , stage0 ? return (fmap (root -/-) includesDependencies) ]
-
-generate :: FilePath -> Context -> Expr String -> Action ()
-generate file context expr = do
- contents <- interpretInContext context expr
- writeFileChanged file contents
- putSuccess $ "| Successfully generated " ++ file ++ "."
-
-generatePackageCode :: Context -> Rules ()
-generatePackageCode context@(Context stage pkg _) =
- let dir = contextDir context
- generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
- 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]
-
-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)
- "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
- "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
- where
- pattern <~ mdir = pattern %> \file -> do
- dir <- mdir
- copyFile (dir -/- takeFileName file) file
-
-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
-
- ghcSplitPath %> \_ -> do
- generate ghcSplitPath emptyTarget generateGhcSplit
- makeExecutable ghcSplitPath
-
- -- TODO: simplify, get rid of fake rts context
- "//" ++ generatedDir ++ "//*" %> \file -> do
- withTempDir $ \dir -> build $
- target rtsContext DeriveConstants [] [file, dir]
- where
- file <~ gen = file %> \out -> generate out emptyTarget gen
-
--- TODO: Use the Types, Luke! (drop partial function)
--- We sometimes need to evaluate expressions that do not require knowing all
--- information about the context. In this case, we don't want to know anything.
-emptyTarget :: Context
-emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
- (error "Rules.Generate.emptyTarget: unknown package")
-
--- Generators
-
--- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
--- the resulting 'String' is a valid C preprocessor identifier.
-cppify :: String -> String
-cppify = replaceEq '-' '_' . replaceEq '.' '_'
-
-ghcSplitSource :: FilePath
-ghcSplitSource = "driver/split/ghc-split.pl"
-
--- ref: rules/build-perl.mk
--- | Generate the @ghc-split@ Perl script.
-generateGhcSplit :: Expr String
-generateGhcSplit = do
- trackGenerateHs
- targetPlatform <- getSetting TargetPlatform
- ghcEnableTNC <- expr $ yesNo <$> ghcEnableTablesNextToCode
- perlPath <- getBuilderPath Perl
- contents <- expr $ readFileLines ghcSplitSource
- return . unlines $
- [ "#!" ++ perlPath
- , "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";"
- -- I don't see where the ghc-split tool uses TNC, but
- -- it's in the build-perl macro.
- , "my $TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
- ] ++ contents
-
--- | Generate @ghcplatform.h@ header.
-generateGhcPlatformH :: Expr String
-generateGhcPlatformH = do
- trackGenerateHs
- hostPlatform <- getSetting HostPlatform
- hostArch <- getSetting HostArch
- hostOs <- getSetting HostOs
- hostVendor <- getSetting HostVendor
- targetPlatform <- getSetting TargetPlatform
- targetArch <- getSetting TargetArch
- targetOs <- getSetting TargetOs
- targetVendor <- getSetting TargetVendor
- ghcUnreg <- expr $ flag GhcUnregisterised
- return . unlines $
- [ "#ifndef __GHCPLATFORM_H__"
- , "#define __GHCPLATFORM_H__"
- , ""
- , "#define BuildPlatform_TYPE " ++ cppify hostPlatform
- , "#define HostPlatform_TYPE " ++ cppify targetPlatform
- , ""
- , "#define " ++ cppify hostPlatform ++ "_BUILD 1"
- , "#define " ++ cppify targetPlatform ++ "_HOST 1"
- , ""
- , "#define " ++ hostArch ++ "_BUILD_ARCH 1"
- , "#define " ++ targetArch ++ "_HOST_ARCH 1"
- , "#define BUILD_ARCH " ++ show hostArch
- , "#define HOST_ARCH " ++ show targetArch
- , ""
- , "#define " ++ hostOs ++ "_BUILD_OS 1"
- , "#define " ++ targetOs ++ "_HOST_OS 1"
- , "#define BUILD_OS " ++ show hostOs
- , "#define HOST_OS " ++ show targetOs
- , ""
- , "#define " ++ hostVendor ++ "_BUILD_VENDOR 1"
- , "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
- , "#define BUILD_VENDOR " ++ show hostVendor
- , "#define HOST_VENDOR " ++ show targetVendor
- , ""
- , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
- , "#define TargetPlatform_TYPE " ++ cppify targetPlatform
- , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
- , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
- , "#define TARGET_ARCH " ++ show targetArch
- , "#define " ++ targetOs ++ "_TARGET_OS 1"
- , "#define TARGET_OS " ++ show targetOs
- , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
- ++
- [ "#define UnregisterisedCompiler 1" | ghcUnreg ]
- ++
- [ "\n#endif /* __GHCPLATFORM_H__ */" ]
-
--- | Generate @Config.hs@ files.
-generateConfigHs :: Expr String
-generateConfigHs = do
- trackGenerateHs
- cProjectName <- getSetting ProjectName
- cProjectGitCommitId <- getSetting ProjectGitCommitId
- cProjectVersion <- getSetting ProjectVersion
- cProjectVersionInt <- getSetting ProjectVersionInt
- cProjectPatchLevel <- getSetting ProjectPatchLevel
- cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
- cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
- cBooterVersion <- getSetting GhcVersion
- intLib <- getIntegerPackage
- debugged <- ghcDebugged <$> expr flavour
- let cIntegerLibraryType
- | intLib == integerGmp = "IntegerGMP"
- | intLib == integerSimple = "IntegerSimple"
- | otherwise = error $ "Unknown integer library: " ++ pkgName intLib
- cSupportsSplitObjs <- expr $ yesNo <$> supportsSplitObjects
- cGhcWithInterpreter <- expr $ yesNo <$> ghcWithInterpreter
- cGhcWithNativeCodeGen <- expr $ yesNo <$> ghcWithNativeCodeGen
- cGhcWithSMP <- expr $ yesNo <$> ghcWithSMP
- cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode
- cLeadingUnderscore <- expr $ yesNo <$> flag LeadingUnderscore
- cGHC_UNLIT_PGM <- fmap takeFileName $ getBuilderPath Unlit
- cLibFFI <- expr useLibFFIForAdjustors
- rtsWays <- getRtsWays
- cGhcRtsWithLibdw <- expr $ flag WithLibdw
- let cGhcRTSWays = unwords $ map show rtsWays
- return $ unlines
- [ "{-# LANGUAGE CPP #-}"
- , "module Config where"
- , ""
- , "import GhcPrelude"
- , ""
- , "#include \"ghc_boot_platform.h\""
- , ""
- , "data IntegerLibrary = IntegerGMP"
- , " | IntegerSimple"
- , " deriving Eq"
- , ""
- , "cBuildPlatformString :: String"
- , "cBuildPlatformString = BuildPlatform_NAME"
- , "cHostPlatformString :: String"
- , "cHostPlatformString = HostPlatform_NAME"
- , "cTargetPlatformString :: String"
- , "cTargetPlatformString = TargetPlatform_NAME"
- , ""
- , "cProjectName :: String"
- , "cProjectName = " ++ show cProjectName
- , "cProjectGitCommitId :: String"
- , "cProjectGitCommitId = " ++ show cProjectGitCommitId
- , "cProjectVersion :: String"
- , "cProjectVersion = " ++ show cProjectVersion
- , "cProjectVersionInt :: String"
- , "cProjectVersionInt = " ++ show cProjectVersionInt
- , "cProjectPatchLevel :: String"
- , "cProjectPatchLevel = " ++ show cProjectPatchLevel
- , "cProjectPatchLevel1 :: String"
- , "cProjectPatchLevel1 = " ++ show cProjectPatchLevel1
- , "cProjectPatchLevel2 :: String"
- , "cProjectPatchLevel2 = " ++ show cProjectPatchLevel2
- , "cBooterVersion :: String"
- , "cBooterVersion = " ++ show cBooterVersion
- , "cStage :: String"
- , "cStage = show (STAGE :: Int)"
- , "cIntegerLibrary :: String"
- , "cIntegerLibrary = " ++ show (pkgName intLib)
- , "cIntegerLibraryType :: IntegerLibrary"
- , "cIntegerLibraryType = " ++ cIntegerLibraryType
- , "cSupportsSplitObjs :: String"
- , "cSupportsSplitObjs = " ++ show cSupportsSplitObjs
- , "cGhcWithInterpreter :: String"
- , "cGhcWithInterpreter = " ++ show cGhcWithInterpreter
- , "cGhcWithNativeCodeGen :: String"
- , "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
- , "cGhcWithSMP :: String"
- , "cGhcWithSMP = " ++ show cGhcWithSMP
- , "cGhcRTSWays :: String"
- , "cGhcRTSWays = " ++ show cGhcRTSWays
- , "cGhcEnableTablesNextToCode :: String"
- , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode
- , "cLeadingUnderscore :: String"
- , "cLeadingUnderscore = " ++ show cLeadingUnderscore
- , "cGHC_UNLIT_PGM :: String"
- , "cGHC_UNLIT_PGM = " ++ show cGHC_UNLIT_PGM
- , "cGHC_SPLIT_PGM :: String"
- , "cGHC_SPLIT_PGM = " ++ show "ghc-split"
- , "cLibFFI :: Bool"
- , "cLibFFI = " ++ show cLibFFI
- , "cGhcThreaded :: Bool"
- , "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
- , "cGhcDebugged :: Bool"
- , "cGhcDebugged = " ++ show debugged
- , "cGhcRtsWithLibdw :: Bool"
- , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
-
--- | Generate @ghcautoconf.h@ header.
-generateGhcAutoconfH :: Expr String
-generateGhcAutoconfH = do
- trackGenerateHs
- configHContents <- expr $ map undefinePackage <$> readFileLines configH
- tablesNextToCode <- expr ghcEnableTablesNextToCode
- ghcUnreg <- expr $ flag GhcUnregisterised
- ccLlvmBackend <- getSetting CcLlvmBackend
- ccClangBackend <- getSetting CcClangBackend
- return . unlines $
- [ "#ifndef __GHCAUTOCONF_H__"
- , "#define __GHCAUTOCONF_H__" ]
- ++ configHContents ++
- [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ]
- ++
- [ "\n#define llvm_CC_FLAVOR 1" | ccLlvmBackend == "1" ]
- ++
- [ "\n#define clang_CC_FLAVOR 1" | ccClangBackend == "1" ]
- ++
- [ "#endif /* __GHCAUTOCONF_H__ */" ]
- where
- undefinePackage s
- | "#define PACKAGE_" `isPrefixOf` s
- = "/* #undef " ++ takeWhile (/=' ') (drop 8 s) ++ " */"
- | otherwise = s
-
--- | Generate @ghc_boot_platform.h@ headers.
-generateGhcBootPlatformH :: Expr String
-generateGhcBootPlatformH = do
- trackGenerateHs
- stage <- getStage
- let chooseSetting x y = getSetting $ if stage == Stage0 then x else y
- buildPlatform <- chooseSetting BuildPlatform HostPlatform
- buildArch <- chooseSetting BuildArch HostArch
- buildOs <- chooseSetting BuildOs HostOs
- buildVendor <- chooseSetting BuildVendor HostVendor
- hostPlatform <- chooseSetting HostPlatform TargetPlatform
- hostArch <- chooseSetting HostArch TargetArch
- hostOs <- chooseSetting HostOs TargetOs
- hostVendor <- chooseSetting HostVendor TargetVendor
- targetPlatform <- getSetting TargetPlatform
- targetArch <- getSetting TargetArch
- llvmTarget <- getSetting LlvmTarget
- targetOs <- getSetting TargetOs
- targetVendor <- getSetting TargetVendor
- return $ unlines
- [ "#ifndef __PLATFORM_H__"
- , "#define __PLATFORM_H__"
- , ""
- , "#define BuildPlatform_NAME " ++ show buildPlatform
- , "#define HostPlatform_NAME " ++ show hostPlatform
- , "#define TargetPlatform_NAME " ++ show targetPlatform
- , ""
- , "#define " ++ cppify buildPlatform ++ "_BUILD 1"
- , "#define " ++ cppify hostPlatform ++ "_HOST 1"
- , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
- , ""
- , "#define " ++ buildArch ++ "_BUILD_ARCH 1"
- , "#define " ++ hostArch ++ "_HOST_ARCH 1"
- , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
- , "#define BUILD_ARCH " ++ show buildArch
- , "#define HOST_ARCH " ++ show hostArch
- , "#define TARGET_ARCH " ++ show targetArch
- , "#define LLVM_TARGET " ++ show llvmTarget
- , ""
- , "#define " ++ buildOs ++ "_BUILD_OS 1"
- , "#define " ++ hostOs ++ "_HOST_OS 1"
- , "#define " ++ targetOs ++ "_TARGET_OS 1"
- , "#define BUILD_OS " ++ show buildOs
- , "#define HOST_OS " ++ show hostOs
- , "#define TARGET_OS " ++ show targetOs
- , ""
- , "#define " ++ buildVendor ++ "_BUILD_VENDOR 1"
- , "#define " ++ hostVendor ++ "_HOST_VENDOR 1"
- , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1"
- , "#define BUILD_VENDOR " ++ show buildVendor
- , "#define HOST_VENDOR " ++ show hostVendor
- , "#define TARGET_VENDOR " ++ show targetVendor
- , ""
- , "#endif /* __PLATFORM_H__ */" ]
-
--- | Generate @ghcversion.h@ header.
-generateGhcVersionH :: Expr String
-generateGhcVersionH = do
- trackGenerateHs
- version <- getSetting ProjectVersionInt
- patchLevel1 <- getSetting ProjectPatchLevel1
- patchLevel2 <- getSetting ProjectPatchLevel2
- return . unlines $
- [ "#ifndef __GHCVERSION_H__"
- , "#define __GHCVERSION_H__"
- , ""
- , "#ifndef __GLASGOW_HASKELL__"
- , "# define __GLASGOW_HASKELL__ " ++ version
- , "#endif"
- , ""]
- ++
- [ "#define __GLASGOW_HASKELL_PATCHLEVEL1__ " ++ patchLevel1 | patchLevel1 /= "" ]
- ++
- [ "#define __GLASGOW_HASKELL_PATCHLEVEL2__ " ++ patchLevel2 | patchLevel2 /= "" ]
- ++
- [ ""
- , "#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\\"
- , " ((ma)*100+(mi)) < __GLASGOW_HASKELL__ || \\"
- , " ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \\"
- , " && (pl1) < __GLASGOW_HASKELL_PATCHLEVEL1__ || \\"
- , " ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \\"
- , " && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \\"
- , " && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )"
- , ""
- , "#endif /* __GHCVERSION_H__ */" ]
-
--- | Generate @Version.hs@ files.
-generateVersionHs :: Expr String
-generateVersionHs = do
- trackGenerateHs
- projectVersion <- getSetting ProjectVersion
- targetOs <- getSetting TargetOs
- targetArch <- getSetting TargetArch
- return $ unlines
- [ "module Version where"
- , "version, targetOS, targetARCH :: String"
- , "version = " ++ show projectVersion
- , "targetOS = " ++ show targetOs
- , "targetARCH = " ++ show targetArch ]
diff --git a/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
deleted file mode 100644
index 46fad8a32c..0000000000
--- a/hadrian/src/Rules/Gmp.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-module Rules.Gmp (
- gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH, gmpBuildInfoPath
- ) where
-
-import Base
-import Context
-import GHC
-import Oracles.Setting
-import Target
-import Utilities
-
-gmpBase :: FilePath
-gmpBase = pkgPath integerGmp -/- "gmp"
-
-gmpLibraryInTreeH :: FilePath
-gmpLibraryInTreeH = "include/gmp.h"
-
-gmpLibrary :: FilePath
-gmpLibrary = ".libs/libgmp.a"
-
--- | GMP is considered a Stage1 package. This determines GMP build directory.
-gmpContext :: Context
-gmpContext = vanillaContext Stage1 integerGmp
-
--- | Build directory for in-tree GMP library.
-gmpBuildPath :: Action FilePath
-gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
-
--- | GMP library header, relative to 'gmpBuildPath'.
-gmpLibraryH :: FilePath
-gmpLibraryH = "include/ghc-gmp.h"
-
--- | Directory for GMP library object files, relative to 'gmpBuildPath'.
-gmpObjectsDir :: FilePath
-gmpObjectsDir = "objs"
-
--- | Path to the GMP library buildinfo file.
-gmpBuildInfoPath :: FilePath
-gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo"
-
-configureEnvironment :: Action [CmdOption]
-configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
- , builderEnvironment "AR" (Ar Unpack Stage1)
- , builderEnvironment "NM" Nm ]
-
-gmpRules :: Rules ()
-gmpRules = do
- -- Copy appropriate GMP header and object files
- "//" ++ gmpLibraryH %> \header -> do
- windows <- windowsHost
- configMk <- readFile' $ gmpBase -/- "config.mk"
- if not windows && -- TODO: We don't use system GMP on Windows. Fix?
- any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
- then do
- putBuild "| GMP library/framework detected and will be used"
- copyFile (gmpBase -/- "ghc-gmp.h") header
- else do
- putBuild "| No GMP library/framework detected; in tree GMP will be built"
- gmpPath <- gmpBuildPath
- need [gmpPath -/- gmpLibrary]
- createDirectory (gmpPath -/- gmpObjectsDir)
- top <- topDirectory
- build $ target gmpContext (Ar Unpack Stage1)
- [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
- copyFile (gmpPath -/- "gmp.h") header
- copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
-
- -- Build in-tree GMP library
- "//" ++ 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
- "//" ++ gmpLibraryInTreeH %> \_ -> do
- 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]
-
- -- Run GMP's configure script
- -- TODO: Get rid of hard-coded @gmp@.
- "//gmp/Makefile" %> \mk -> do
- env <- configureEnvironment
- gmpPath <- gmpBuildPath
- need [mk <.> "in"]
- buildWithCmdOptions env $
- target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
-
- -- Extract in-tree GMP sources and apply patches
- "//gmp/Makefile.in" %> \_ -> do
- gmpPath <- gmpBuildPath
- removeDirectory gmpPath
- -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
- -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
- -- That's because the doc/ directory contents are under the GFDL,
- -- which causes problems for Debian.
- tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
- <$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
-
- withTempDir $ \dir -> do
- let tmp = unifyPath dir
- need [tarball]
- build $ target gmpContext (Tar Extract) [tarball] [tmp]
-
- let patch = gmpBase -/- "gmpsrc.patch"
- patchName = takeFileName patch
- copyFile patch $ tmp -/- patchName
- applyPatch tmp patchName
-
- let name = dropExtension . dropExtension $ takeFileName tarball
- unpack = fromMaybe . error $ "gmpRules: expected suffix "
- ++ "-nodoc (found: " ++ name ++ ")."
- libName = unpack $ stripSuffix "-nodoc" name
-
- moveDirectory (tmp -/- libName) gmpPath
diff --git a/hadrian/src/Rules/Install.hs b/hadrian/src/Rules/Install.hs
deleted file mode 100644
index bcdbf33e34..0000000000
--- a/hadrian/src/Rules/Install.hs
+++ /dev/null
@@ -1,336 +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 = (-/- "bin") <$> installGhcLibDir
-
--- 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
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
deleted file mode 100644
index 73f481d88a..0000000000
--- a/hadrian/src/Rules/Libffi.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
-
-import Hadrian.Utilities
-
-import Settings.Builders.Common
-import Settings.Packages.Rts
-import Target
-import Utilities
-
--- | Libffi is considered a Stage1 package. This determines its build directory.
-libffiContext :: Context
-libffiContext = vanillaContext Stage1 libffi
-
--- | Build directory for in-tree Libffi library.
-libffiBuildPath :: Action FilePath
-libffiBuildPath = buildPath libffiContext
-
-libffiDependencies :: [FilePath]
-libffiDependencies = ["ffi.h", "ffitarget.h"]
-
-libffiLibrary :: FilePath
-libffiLibrary = "inst/lib/libffi.a"
-
-fixLibffiMakefile :: FilePath -> String -> String
-fixLibffiMakefile top =
- replace "-MD" "-MMD"
- . replace "@toolexeclibdir@" "$(libdir)"
- . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
-
--- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs)
--- TODO: check code duplication w.r.t. ConfCcArgs
-configureEnvironment :: Action [CmdOption]
-configureEnvironment = do
- cFlags <- interpretInContext libffiContext $ mconcat
- [ cArgs
- , getStagedSettingList ConfCcArgs ]
- ldFlags <- interpretInContext libffiContext ldArgs
- sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
- , builderEnvironment "CXX" $ Cc CompileC Stage1
- , builderEnvironment "LD" Ld
- , builderEnvironment "AR" (Ar Unpack Stage1)
- , builderEnvironment "NM" Nm
- , builderEnvironment "RANLIB" Ranlib
- , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w"
- , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
-
-libffiRules :: Rules ()
-libffiRules = do
- fmap ("//rts" -/-) libffiDependencies &%> \_ -> do
- libffiPath <- libffiBuildPath
- need [libffiPath -/- libffiLibrary]
-
- "//" ++ libffiLibrary %> \_ -> do
- useSystemFfi <- flag UseSystemFfi
- rtsPath <- rtsBuildPath
- if useSystemFfi
- then do
- ffiIncludeDir <- setting FfiIncludeDir
- putBuild "| System supplied FFI library will be used"
- forM_ ["ffi.h", "ffitarget.h"] $ \file ->
- copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
- putSuccess "| Successfully copied system FFI library header files"
- else do
- libffiPath <- libffiBuildPath
- build $ target libffiContext (Make libffiPath) [] []
-
- hs <- getDirectoryFiles "" [libffiPath -/- "inst/include/*"]
- forM_ hs $ \header ->
- copyFile header (rtsPath -/- takeFileName header)
-
- ways <- interpretInContext libffiContext (getLibraryWays <> getRtsWays)
- forM_ (nubOrd ways) $ \way -> do
- rtsLib <- rtsLibffiLibrary way
- copyFileUntracked (libffiPath -/- libffiLibrary) rtsLib
-
- putSuccess "| Successfully built custom library 'libffi'"
-
- "//libffi/Makefile.in" %> \mkIn -> do
- libffiPath <- libffiBuildPath
- removeDirectory libffiPath
- tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
- <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
-
- need [tarball]
- -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
- let libname = takeWhile (/= '+') $ takeFileName tarball
-
- root <- buildRoot
- removeDirectory (root -/- libname)
- -- TODO: Simplify.
- actionFinally (do
- build $ target libffiContext (Tar Extract) [tarball] [root]
- moveDirectory (root -/- libname) libffiPath) $
- removeFiles root [libname <//> "*"]
-
- top <- topDirectory
- fixFile mkIn (fixLibffiMakefile top)
-
- -- TODO: Get rid of hard-coded @libffi@.
- "//libffi/Makefile" %> \mk -> do
- need [mk <.> "in"]
- libffiPath <- libffiBuildPath
- forM_ ["config.guess", "config.sub"] $ \file ->
- copyFile file (libffiPath -/- file)
-
- env <- configureEnvironment
- buildWithCmdOptions env $
- target libffiContext (Configure libffiPath) [mk <.> "in"] [mk]
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
deleted file mode 100644
index e6e5b167ff..0000000000
--- a/hadrian/src/Rules/Library.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-module Rules.Library (
- buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
- ) where
-
-import Hadrian.Haskell.Cabal
-import qualified System.Directory as IO
-
-import Base
-import Context
-import Expression hiding (way, package)
-import Flavour
-import Oracles.ModuleFiles
-import Oracles.PackageData
-import Oracles.Setting
-import Rules.Gmp
-import Settings
-import Target
-import Utilities
-
-libraryObjects :: Context -> Action [FilePath]
-libraryObjects context@Context{..} = do
- hsObjs <- hsObjects context
- noHsObjs <- nonHsObjects context
-
- -- This will create split objects if required (we don't track them
- -- explicitly as this would needlessly bloat the Shake database).
- need $ noHsObjs ++ hsObjs
-
- split <- interpretInContext context =<< splitObjects <$> flavour
- let getSplitObjs = concatForM hsObjs $ \obj -> do
- let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
- contents <- liftIO $ IO.getDirectoryContents dir
- return . map (dir -/-) $ filter (not . all (== '.')) contents
-
- (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
-
-buildDynamicLib :: Context -> Rules ()
-buildDynamicLib context@Context{..} = do
- let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
- -- OS X
- libPrefix ++ "*.dylib" %> buildDynamicLibUnix
- -- Linux
- libPrefix ++ "*.so" %> buildDynamicLibUnix
- -- TODO: Windows
- where
- buildDynamicLibUnix lib = do
- deps <- contextDependencies context
- need =<< mapM pkgLibraryFile deps
- objs <- libraryObjects context
- build $ target context (Ghc LinkHs stage) objs [lib]
-
-buildPackageLibrary :: Context -> Rules ()
-buildPackageLibrary context@Context {..} = do
- let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
- libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do
- objs <- libraryObjects context
- asuf <- libsuf way
- let isLib0 = ("//*-0" ++ asuf) ?== a
- removeFile 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)
- unless isLib0 . putSuccess $ renderLibrary
- (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
- ++ show way ++ ").") a synopsis
-
-buildPackageGhciLibrary :: Context -> Rules ()
-buildPackageGhciLibrary context@Context {..} = priority 2 $ do
- let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package
- libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
- objs <- allObjects context
- need objs
- build $ target context Ld objs [obj]
-
-allObjects :: Context -> Action [FilePath]
-allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
-
-nonHsObjects :: Context -> Action [FilePath]
-nonHsObjects context = do
- path <- buildPath context
- cObjs <- cObjects context
- cmmSrcs <- pkgDataList (CmmSrcs path)
- 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)
- 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
- | package context == integerGmp = do
- gmpPath <- gmpBuildPath
- need [gmpPath -/- gmpLibraryH]
- map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
- | otherwise = return []
diff --git a/hadrian/src/Rules/PackageData.hs b/hadrian/src/Rules/PackageData.hs
deleted file mode 100644
index 2442b03de3..0000000000
--- a/hadrian/src/Rules/PackageData.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-module Rules.PackageData (buildPackageData) where
-
-import Base
-import Context
-import Expression
-import Oracles.Setting
-import Rules.Generate
-import Settings.Packages.Rts
-import Target
-import Utilities
-
--- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
-buildPackageData :: Context -> Rules ()
-buildPackageData context@Context {..} = do
- let 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
-
- 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
- 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
- rtsPath <- rtsBuildPath
- sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) .
- map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++
- [ if windows then "win32" else "posix" ]
- return $ sources ++ [ rtsPath -/- "c/sm/Evac_thr.c" ]
- ++ [ rtsPath -/- "c/sm/Scav_thr.c" ]
-
-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
- 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
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
deleted file mode 100644
index dca177f879..0000000000
--- a/hadrian/src/Rules/Program.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-module Rules.Program (buildProgram) where
-
-import Hadrian.Haskell.Cabal
-
-import Base
-import Context
-import Expression hiding (stage, way)
-import Oracles.ModuleFiles
-import Oracles.PackageData
-import Oracles.Setting
-import Rules.Wrappers
-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
-
- -- Rules for programs built in 'buildRoot'
- "//" ++ contextDir context -/- programName context <.> exe %> \bin ->
- buildBinaryAndWrapper rs bin =<< programContext stage package
-
- -- Rules for the GHC package, which is built 'inplace'
- when (package == ghc) $ do
- inplaceBinPath -/- programName context <.> exe %> \bin ->
- buildBinaryAndWrapper rs bin =<< programContext stage package
-
- inplaceLibBinPath -/- programName context <.> exe %> \bin ->
- buildBinary rs bin =<< programContext stage package
-
- inplaceLibBinPath -/- programName context <.> "bin" %> \bin ->
- buildBinary rs bin =<< programContext stage package
-
- -- 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 ++ ")."
-
-buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
-buildBinary rs bin context@Context {..} = do
- binDeps <- if stage == Stage0 && package == ghcCabal
- then hsSources context
- else do
- needLibrary =<< contextDependencies context
- when (stage > Stage0) $ do
- ways <- interpretInContext context (getLibraryWays <> getRtsWays)
- needLibrary [ rtsContext { way = w } | w <- ways ]
- path <- buildPath context
- cSrcs <- pkgDataList (CSrcs path)
- 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)
- putSuccess $ renderProgram
- (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
deleted file mode 100644
index 7c0a3e00e8..0000000000
--- a/hadrian/src/Rules/Register.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Rules.Register (registerPackage) where
-
-import Base
-import Context
-import GHC
-import Target
-import Utilities
-
--- TODO: Simplify.
--- | Build rules for registering packages and initialising package databases
--- by running the @ghc-pkg@ utility.
-registerPackage :: [(Resource, Int)] -> Context -> Rules ()
-registerPackage rs context@Context {..} = 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
-
- when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %>
- buildStamp rs context
-
- when (stage == Stage1) $ do
- inplacePackageDbPath -/- pkgName package ++ "*.conf" %%>
- buildConf rs context
-
- when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %>
- buildStamp rs context
-
-buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildConf rs context@Context {..} conf = do
- confIn <- pkgInplaceConfig context
- need [confIn]
- buildWithResources rs $ target context (GhcPkg Update stage) [confIn] [conf]
-
-buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildStamp rs Context {..} stamp = do
- let path = takeDirectory stamp
- removeDirectory path
- buildWithResources rs $
- target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
- writeFileLines stamp []
- putSuccess $ "| Successfully initialised " ++ path
diff --git a/hadrian/src/Rules/Selftest.hs b/hadrian/src/Rules/Selftest.hs
deleted file mode 100644
index d1ffaac1c3..0000000000
--- a/hadrian/src/Rules/Selftest.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Rules.Selftest (selftestRules) where
-
-import Test.QuickCheck
-
-import Base
-import GHC
-import Oracles.ModuleFiles
-import Oracles.Setting
-import Settings
-import Target
-
-instance Arbitrary Way where
- arbitrary = wayFromUnits <$> arbitrary
-
-instance Arbitrary WayUnit where
- arbitrary = arbitraryBoundedEnum
-
-test :: Testable a => a -> Action ()
-test = liftIO . quickCheck
-
-selftestRules :: Rules ()
-selftestRules =
- "selftest" ~> do
- testBuilder
- testChunksOfSize
- testLookupAll
- testModuleName
- testPackages
- testWay
-
-testBuilder :: Action ()
-testBuilder = do
- putBuild "==== trackArgument"
- let make = target undefined (Make undefined) undefined undefined
- test $ forAll (elements ["-j", "MAKEFLAGS=-j", "THREADS="])
- $ \prefix (NonNegative n) ->
- not (trackArgument make prefix) &&
- not (trackArgument make ("-j" ++ show (n :: Int)))
-
-testChunksOfSize :: Action ()
-testChunksOfSize = do
- putBuild "==== chunksOfSize"
- test $ chunksOfSize 3 [ "a", "b", "c" , "defg" , "hi" , "jk" ]
- == [ ["a", "b", "c"], ["defg"], ["hi"], ["jk"] ]
- test $ \n xs ->
- let res = chunksOfSize n xs
- in concat res == xs && all (\r -> length r == 1 || length (concat r) <= n) res
-
-testLookupAll :: Action ()
-testLookupAll = do
- putBuild "==== lookupAll"
- test $ lookupAll ["b" , "c" ] [("a", 1), ("c", 3), ("d", 4)]
- == [Nothing, Just (3 :: Int)]
- test $ forAll dicts $ \dict -> forAll extras $ \extra ->
- let items = sort $ map fst dict ++ extra
- in lookupAll items (sort dict) == map (`lookup` dict) items
- where
- dicts :: Gen [(Int, Int)]
- dicts = nubBy (\x y -> fst x == fst y) <$> vector 20
- extras :: Gen [Int]
- extras = vector 20
-
-testModuleName :: Action ()
-testModuleName = do
- putBuild "==== Encode/decode module name"
- test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
- test $ encodeModule "" "Prelude" == "Prelude"
-
- test $ decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
- test $ decodeModule "Prelude" == ("", "Prelude")
-
- test $ forAll names $ \n -> uncurry encodeModule (decodeModule n) == n
- where
- names = intercalate "." <$> listOf1 (listOf1 $ elements "abcABC123_'")
-
-testPackages :: Action ()
-testPackages = do
- putBuild "==== Check system configuration"
- win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.
- putBuild "==== Packages, interpretInContext, configuration flags"
- forM_ [Stage0 ..] $ \stage -> do
- pkgs <- stagePackages stage
- when (win32 `elem` pkgs) . test $ win
- when (unix `elem` pkgs) . test $ not win
- test $ pkgs == nubOrd pkgs
-
-testWay :: Action ()
-testWay = do
- putBuild "==== Read Way, Show Way"
- test $ \(x :: Way) -> read (show x) == x
-
diff --git a/hadrian/src/Rules/SourceDist.hs b/hadrian/src/Rules/SourceDist.hs
deleted file mode 100644
index 3143c4b153..0000000000
--- a/hadrian/src/Rules/SourceDist.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-module Rules.SourceDist (sourceDistRules) where
-
-import Hadrian.Oracles.DirectoryContents
-
-import Base
-import Builder
-import Oracles.Setting
-import Rules.Clean
-
-sourceDistRules :: Rules ()
-sourceDistRules = do
- "sdist-ghc" ~> do
- -- We clean the source tree first.
- -- See https://github.com/snowleopard/hadrian/issues/384.
- cleanSourceTree
- version <- setting ProjectVersion
- need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"]
- putSuccess "| Done"
- "sdistprep/ghc-*-src.tar.xz" %> \fname -> do
- let tarName = takeFileName fname
- dropTarXz = dropExtension . dropExtension
- treePath = "sdistprep/ghc" -/- dropTarXz tarName
- prepareTree treePath
- runBuilderWithCmdOptions [Cwd "sdistprep/ghc"] (Tar Create)
- ["cJf", ".." -/- tarName, dropTarXz tarName]
- ["cJf", ".." -/- tarName] [dropTarXz tarName]
- "GIT_COMMIT_ID" %> \fname ->
- writeFileChanged fname =<< setting ProjectGitCommitId
- "VERSION" %> \fname ->
- writeFileChanged fname =<< setting ProjectVersion
-
-prepareTree :: FilePath -> Action ()
-prepareTree dest = do
- mapM_ cpDir srcDirs
- mapM_ cpFile srcFiles
- where
- cpFile a = copyFile a (dest -/- a)
- cpDir a = copyDirectoryContents (Not excluded) a (dest -/- a)
- excluded = Or
- [ Test "//.*"
- , Test "//#*"
- , Test "//*-SAVE"
- , Test "//*.orig"
- , Test "//*.rej"
- , Test "//*~"
- , Test "//autom4te*"
- , Test "//dist"
- , Test "//dist-install"
- , Test "//log"
- , Test "//stage0"
- , Test "//stage1"
- , Test "//stage2"
- , Test "//stage3"
- , Test "hadrian/.cabal-sandbox"
- , Test "hadrian/.stack-work"
- , Test "hadrian/UserSettings.hs"
- , Test "hadrian/cabal.sandbox.config"
- , Test "hadrian/cfg/system.config"
- , Test "hadrian/bin"
- , Test "hadrian/dist"
- , Test "hadrian/dist-newstyle"
- , Test "libraries//*.buildinfo"
- , Test "libraries//GNUmakefile"
- , Test "libraries//config.log"
- , Test "libraries//config.status"
- , Test "libraries//configure"
- , Test "libraries//ghc.mk"
- , Test "libraries//include/Hs*Config.h"
- , Test "libraries/dph"
- , Test "libraries/parallel"
- , Test "libraries/primitive"
- , Test "libraries/random"
- , Test "libraries/stm"
- , Test "libraries/vector"
- , Test "mk/build.mk" ]
- srcDirs =
- [ "bindisttest"
- , "compiler"
- , "distrib"
- , "docs"
- , "docs"
- , "driver"
- , "ghc"
- , "hadrian"
- , "includes"
- , "iserv"
- , "libffi"
- , "libffi-tarballs"
- , "libraries"
- , "mk"
- , "rts"
- , "rules"
- , "utils" ]
- srcFiles =
- [ "ANNOUNCE"
- , "GIT_COMMIT_ID"
- , "HACKING.md"
- , "INSTALL.md"
- , "LICENSE"
- , "MAKEHELP.md"
- , "Makefile"
- , "README.md"
- , "VERSION"
- , "aclocal.m4"
- , "boot"
- , "config.guess"
- , "config.sub"
- , "configure"
- , "configure.ac"
- , "ghc.mk"
- , "install-sh"
- , "packages"
- , "settings.in" ]
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
deleted file mode 100644
index ae37343432..0000000000
--- a/hadrian/src/Rules/Test.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module Rules.Test (testRules) where
-
-import Base
-import Expression
-import Flavour
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-import Target
-import Utilities
-
--- TODO: clean up after testing
-testRules :: Rules ()
-testRules = do
- "validate" ~> do
- need inplaceLibCopyTargets
- needBuilder $ Ghc CompileHs Stage2
- needBuilder $ GhcPkg Update Stage1
- needBuilder Hpc
- -- TODO: Figure out why @needBuilder Hsc2Hs@ doesn't work.
- -- TODO: Eliminate explicit filepaths.
- -- See https://github.com/snowleopard/hadrian/issues/376.
- need ["inplace/bin/hp2ps", "inplace/bin/hsc2hs"]
- build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
-
- "test" ~> do
- pkgs <- stagePackages Stage1
- tests <- filterM doesDirectoryExist $ concat
- [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
- | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
- windows <- windowsHost
- top <- topDirectory
- compiler <- builderPath $ Ghc CompileHs Stage2
- ghcPkg <- builderPath $ GhcPkg Update Stage1
- haddock <- builderPath (Haddock BuildPackage)
- threads <- shakeThreads <$> getShakeOptions
- debugged <- ghcDebugged <$> flavour
- ghcWithNativeCodeGenInt <- fromEnum <$> ghcWithNativeCodeGen
- ghcWithInterpreterInt <- fromEnum <$> ghcWithInterpreter
- ghcUnregisterisedInt <- fromEnum <$> flag GhcUnregisterised
- quietly . cmd "python2" $
- [ "testsuite/driver/runtests.py" ]
- ++ map ("--rootdir="++) tests ++
- [ "-e", "windows=" ++ show windows
- , "-e", "config.speed=2"
- , "-e", "ghc_compiler_always_flags=" ++ show "-fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-db -rtsopts"
- , "-e", "ghc_with_native_codegen=" ++ show ghcWithNativeCodeGenInt
- , "-e", "ghc_debugged=" ++ show (yesNo debugged)
- , "-e", "ghc_with_vanilla=1" -- TODO: do we always build vanilla?
- , "-e", "ghc_with_dynamic=0" -- TODO: support dynamic
- , "-e", "ghc_with_profiling=0" -- TODO: support profiling
- , "-e", "ghc_with_interpreter=" ++ show ghcWithInterpreterInt
- , "-e", "ghc_unregisterised=" ++ show ghcUnregisterisedInt
- , "-e", "ghc_with_threaded_rts=0" -- TODO: support threaded
- , "-e", "ghc_with_dynamic_rts=0" -- TODO: support dynamic
- , "-e", "ghc_dynamic_by_default=False" -- TODO: support dynamic
- , "-e", "ghc_dynamic=0" -- TODO: support dynamic
- , "-e", "ghc_with_llvm=0" -- TODO: support LLVM
- , "-e", "in_tree_compiler=True" -- TODO: when is it equal to False?
- , "-e", "clean_only=False" -- TODO: do we need to support True?
- , "--configfile=testsuite/config/ghc"
- , "--config", "compiler=" ++ show (top -/- compiler)
- , "--config", "ghc_pkg=" ++ show (top -/- ghcPkg)
- , "--config", "haddock=" ++ show (top -/- haddock)
- , "--summary-file", "testsuite_summary.txt"
- , "--threads=" ++ show threads
- ]
-
- -- , "--config", "hp2ps=" ++ quote ("hp2ps")
- -- , "--config", "hpc=" ++ quote ("hpc")
- -- , "--config", "gs=$(call quote_path,$(GS))"
- -- , "--config", "timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))"
diff --git a/hadrian/src/Rules/Wrappers.hs b/hadrian/src/Rules/Wrappers.hs
deleted file mode 100644
index 20763a778e..0000000000
--- a/hadrian/src/Rules/Wrappers.hs
+++ /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"
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
deleted file mode 100644
index 091efc10ca..0000000000
--- a/hadrian/src/Settings.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-module Settings (
- getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
- findPackageByName, getPkgData, getPkgDataList, isLibrary, stagePackages,
- programContext, getIntegerPackage, getDestDir
- ) where
-
-import CommandLine
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-import Settings.Flavours.Development
-import Settings.Flavours.Performance
-import Settings.Flavours.Profiled
-import Settings.Flavours.Quick
-import Settings.Flavours.Quickest
-import Settings.Flavours.QuickCross
-import UserSettings
-
-getArgs :: Args
-getArgs = expr flavour >>= args
-
-getLibraryWays :: Ways
-getLibraryWays = expr flavour >>= libraryWays
-
-getRtsWays :: Ways
-getRtsWays = expr flavour >>= rtsWays
-
-stagePackages :: Stage -> Action [Package]
-stagePackages stage = do
- f <- flavour
- packages f stage
-
-hadrianFlavours :: [Flavour]
-hadrianFlavours =
- [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2
- , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour
- , quickCrossFlavour ]
-
-flavour :: Action Flavour
-flavour = do
- flavourName <- fromMaybe "default" <$> cmdFlavour
- let unknownFlavour = error $ "Unknown build flavour: " ++ flavourName
- flavours = hadrianFlavours ++ userFlavours
- return $ fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours
-
-getIntegerPackage :: Expr Package
-getIntegerPackage = expr (integerLibrary =<< flavour)
-
-programContext :: Stage -> Package -> Action Context
-programContext stage pkg = do
- profiled <- ghcProfiled <$> flavour
- return $ if pkg == ghc && profiled && stage > Stage0
- then Context stage pkg profiling
- else vanillaContext stage pkg
-
--- TODO: switch to Set Package as the order of packages should not matter?
--- Otherwise we have to keep remembering to sort packages from time to time.
-knownPackages :: [Package]
-knownPackages = sort $ ghcPackages ++ userPackages
-
--- TODO: Speed up? Switch to Set?
--- Note: this is slow but we keep it simple as there are just ~50 packages
-findPackageByName :: PackageName -> Maybe Package
-findPackageByName name = find (\pkg -> pkgName pkg == name) knownPackages
-
--- | Install's DESTDIR setting.
-getDestDir :: Action FilePath
-getDestDir = fromMaybe "" <$> cmdInstallDestDir
diff --git a/hadrian/src/Settings/Builders/Alex.hs b/hadrian/src/Settings/Builders/Alex.hs
deleted file mode 100644
index e0ef1367f7..0000000000
--- a/hadrian/src/Settings/Builders/Alex.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Settings.Builders.Alex (alexBuilderArgs) where
-
-import Settings.Builders.Common
-
-alexBuilderArgs :: Args
-alexBuilderArgs = builder Alex ? mconcat [ arg "-g"
- , arg =<< getInput
- , arg "-o", arg =<< getOutput ]
diff --git a/hadrian/src/Settings/Builders/Cc.hs b/hadrian/src/Settings/Builders/Cc.hs
deleted file mode 100644
index 70d043f76d..0000000000
--- a/hadrian/src/Settings/Builders/Cc.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Settings.Builders.Cc (ccBuilderArgs) where
-
-import Settings.Builders.Common
-
-ccBuilderArgs :: Args
-ccBuilderArgs = do
- way <- getWay
- builder Cc ? mconcat
- [ getPkgDataList CcArgs
- , getStagedSettingList ConfCcArgs
- , cIncludeArgs
-
- , builder (Cc CompileC) ? mconcat
- [ pure ["-Wall", "-Werror"]
- , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
- , arg "-c", arg =<< getInput
- , arg "-o", arg =<< getOutput ]
-
- , builder (Cc FindCDependencies) ? do
- output <- getOutput
- mconcat [ arg "-E"
- , arg "-MM", arg "-MG"
- , arg "-MF", arg output
- , arg "-MT", arg $ dropExtension output -<.> "o"
- , arg "-x", arg "c"
- , arg =<< getInput ] ]
diff --git a/hadrian/src/Settings/Builders/Common.hs b/hadrian/src/Settings/Builders/Common.hs
deleted file mode 100644
index 340239acd6..0000000000
--- a/hadrian/src/Settings/Builders/Common.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-module Settings.Builders.Common (
- module Base,
- module Expression,
- module Oracles.Flag,
- module Oracles.PackageData,
- module Oracles.Setting,
- module Settings,
- module UserSettings,
- cIncludeArgs, ldArgs, cArgs, cWarnings, bootPackageDatabaseArgs
- ) where
-
-import Base
-import Expression
-import Oracles.Flag
-import Oracles.PackageData
-import Oracles.Setting
-import Settings
-import UserSettings
-
-cIncludeArgs :: Args
-cIncludeArgs = do
- pkg <- getPackage
- root <- getBuildRoot
- path <- getBuildPath
- incDirs <- getPkgDataList IncludeDirs
- depDirs <- getPkgDataList DepIncludeDirs
- cross <- expr crossCompiling
- compilerOrGhc <- package compiler ||^ package ghc
- mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes"
- , arg $ "-I" ++ root -/- generatedDir
- , arg $ "-I" ++ path
- , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ]
- , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ]
-
-ldArgs :: Args
-ldArgs = mempty
-
-cArgs :: Args
-cArgs = mempty
-
--- TODO: should be in a different file
-cWarnings :: Args
-cWarnings =
- mconcat [ arg "-Wall"
- , flag GccIsClang ? arg "-Wno-unknown-pragmas"
- , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
- , notM (flag GccIsClang) ? arg "-Wno-error=inline" ]
-
-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
diff --git a/hadrian/src/Settings/Builders/Configure.hs b/hadrian/src/Settings/Builders/Configure.hs
deleted file mode 100644
index 93225b5405..0000000000
--- a/hadrian/src/Settings/Builders/Configure.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module Settings.Builders.Configure (configureBuilderArgs) where
-
-import Rules.Gmp
-import Rules.Libffi
-import Settings.Builders.Common
-
-configureBuilderArgs :: Args
-configureBuilderArgs = do
- gmpPath <- expr gmpBuildPath
- libffiPath <- expr libffiBuildPath
- mconcat [ builder (Configure gmpPath) ? do
- hostPlatform <- getSetting HostPlatform
- buildPlatform <- getSetting BuildPlatform
- pure [ "--enable-shared=no"
- , "--host=" ++ hostPlatform
- , "--build=" ++ buildPlatform ]
-
- , builder (Configure libffiPath) ? do
- top <- expr topDirectory
- targetPlatform <- getSetting TargetPlatform
- pure [ "--prefix=" ++ top -/- libffiPath -/- "inst"
- , "--libdir=" ++ top -/- libffiPath -/- "inst/lib"
- , "--enable-static=yes"
- , "--enable-shared=no" -- TODO: add support for yes
- , "--host=" ++ targetPlatform ] ]
diff --git a/hadrian/src/Settings/Builders/DeriveConstants.hs b/hadrian/src/Settings/Builders/DeriveConstants.hs
deleted file mode 100644
index 7a6e863e9c..0000000000
--- a/hadrian/src/Settings/Builders/DeriveConstants.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where
-
-import Settings.Builders.Common
-
--- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
-deriveConstantsBuilderArgs :: Args
-deriveConstantsBuilderArgs = builder DeriveConstants ? do
- cFlags <- includeCcArgs
- outs <- getOutputs
- let (outputFile, tempDir) = case outs of
- [a, b] -> (a, b)
- _ -> error $ "DeriveConstants: expected two outputs, got " ++ show outs
- mconcat
- [ output "//DerivedConstants.h" ? arg "--gen-header"
- , output "//GHCConstantsHaskellType.hs" ? arg "--gen-haskell-type"
- , output "//platformConstants" ? arg "--gen-haskell-value"
- , output "//GHCConstantsHaskellWrappers.hs" ? arg "--gen-haskell-wrappers"
- , output "//GHCConstantsHaskellExports.hs" ? arg "--gen-haskell-exports"
- , arg "-o", arg outputFile
- , arg "--tmpdir", arg tempDir
- , arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1)
- , pure $ concatMap (\a -> ["--gcc-flag", a]) cFlags
- , arg "--nm-program", arg =<< getBuilderPath Nm
- , isSpecified Objdump ? mconcat [ arg "--objdump-program"
- , arg =<< getBuilderPath Objdump ]
- , arg "--target-os", arg =<< getSetting TargetOs ]
-
-includeCcArgs :: Args
-includeCcArgs = do
- root <- getBuildRoot
- mconcat [ cArgs
- , cWarnings
- , getSettingList $ ConfCcArgs Stage1
- , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
- , arg "-Irts"
- , arg "-Iincludes"
- , arg $ "-I" ++ root -/- generatedDir
- , notM ghcWithSMP ? arg "-DNOSMP"
- , arg "-fcommon" ]
diff --git a/hadrian/src/Settings/Builders/GenPrimopCode.hs b/hadrian/src/Settings/Builders/GenPrimopCode.hs
deleted file mode 100644
index e616ed3b43..0000000000
--- a/hadrian/src/Settings/Builders/GenPrimopCode.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Settings.Builders.GenPrimopCode (genPrimopCodeBuilderArgs) where
-
-import Settings.Builders.Common
-
-genPrimopCodeBuilderArgs :: Args
-genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat
- [ output "//PrimopWrappers.hs" ? arg "--make-haskell-wrappers"
- , output "//Prim.hs" ? arg "--make-haskell-source"
- , output "//primop-data-decl.hs-incl" ? arg "--data-decl"
- , output "//primop-tag.hs-incl" ? arg "--primop-tag"
- , output "//primop-list.hs-incl" ? arg "--primop-list"
- , output "//primop-has-side-effects.hs-incl" ? arg "--has-side-effects"
- , output "//primop-out-of-line.hs-incl" ? arg "--out-of-line"
- , output "//primop-commutable.hs-incl" ? arg "--commutable"
- , output "//primop-code-size.hs-incl" ? arg "--code-size"
- , output "//primop-can-fail.hs-incl" ? arg "--can-fail"
- , output "//primop-strictness.hs-incl" ? arg "--strictness"
- , output "//primop-fixity.hs-incl" ? arg "--fixity"
- , output "//primop-primop-info.hs-incl" ? arg "--primop-primop-info"
- , output "//primop-vector-uniques.hs-incl" ? arg "--primop-vector-uniques"
- , output "//primop-vector-tys.hs-incl" ? arg "--primop-vector-tys"
- , output "//primop-vector-tys-exports.hs-incl" ? arg "--primop-vector-tys-exports"
- , output "//primop-vector-tycons.hs-incl" ? arg "--primop-vector-tycons"
- , output "//primop-usage.hs-incl" ? arg "--usage" ]
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
deleted file mode 100644
index af78b74637..0000000000
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ /dev/null
@@ -1,149 +0,0 @@
-module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
-
-import Hadrian.Haskell.Cabal
-
-import Flavour
-import Rules.Gmp
-import Settings.Builders.Common
-import Settings.Warnings
-
-ghcBuilderArgs :: Args
-ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
-
-compileAndLinkHs :: Args
-compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
- needTouchy
- mconcat [ arg "-Wall"
- , commonGhcArgs
- , splitObjectsArgs
- , ghcLinkArgs
- , defaultGhcWarningsArgs
- , builder (Ghc CompileHs) ? arg "-c"
- , getInputs
- , arg "-o", arg =<< getOutput ]
-
-needTouchy :: Expr ()
-needTouchy = notStage0 ? windowsHost ? do
- touchyPath <- expr $ programPath (vanillaContext Stage0 touchy)
- expr $ need [touchyPath]
-
-compileC :: Args
-compileC = builder (Ghc CompileCWithGhc) ? do
- way <- getWay
- let ccArgs = [ getPkgDataList CcArgs
- , getStagedSettingList ConfCcArgs
- , cIncludeArgs
- , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
- mconcat [ arg "-Wall"
- , ghcLinkArgs
- , commonGhcArgs
- , mconcat (map (map ("-optc" ++) <$>) ccArgs)
- , defaultGhcWarningsArgs
- , arg "-c"
- , getInputs
- , arg "-o"
- , arg =<< getOutput ]
-
-ghcLinkArgs :: Args
-ghcLinkArgs = builder (Ghc LinkHs) ? do
- stage <- getStage
- way <- getWay
- pkg <- getPackage
- libs <- getPkgDataList DepExtraLibs
- libDirs <- getPkgDataList DepLibDirs
- 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 []
- 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 ] ]
-
-splitObjectsArgs :: Args
-splitObjectsArgs = splitObjects <$> flavour ? do
- expr $ need [ghcSplitPath]
- arg "-split-objs"
-
-findHsDependencies :: Args
-findHsDependencies = builder (Ghc FindHsDependencies) ? do
- ways <- getLibraryWays
- mconcat [ arg "-M"
- , commonGhcArgs
- , arg "-include-pkg-deps"
- , arg "-dep-makefile", arg =<< getOutput
- , pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
- , getInputs ]
-
-haddockGhcArgs :: Args
-haddockGhcArgs = mconcat [ commonGhcArgs, getPkgDataList HsArgs ]
-
--- 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]
- mconcat [ arg "-hisuf", arg $ hisuf way
- , arg "-osuf" , arg $ osuf way
- , arg "-hcsuf", arg $ hcsuf way
- , wayGhcArgs
- , packageGhcArgs
- , includeGhcArgs
- , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
- , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
- , map ("-optP" ++) <$> getPkgDataList CppArgs
- , arg "-odir" , arg path
- , arg "-hidir" , arg path
- , arg "-stubdir" , arg path ]
-
--- TODO: Do '-ticky' in all debug ways?
-wayGhcArgs :: Args
-wayGhcArgs = do
- way <- getWay
- mconcat [ if (Dynamic `wayUnit` way)
- then pure ["-fPIC", "-dynamic"]
- else arg "-static"
- , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
- , (Debug `wayUnit` way) ? arg "-optc-DDEBUG"
- , (Profiling `wayUnit` way) ? arg "-prof"
- , (Logging `wayUnit` way) ? arg "-eventlog"
- , (way == debug || way == debugDynamic) ?
- pure ["-ticky", "-DTICKY_TICKY"] ]
-
-packageGhcArgs :: Args
-packageGhcArgs = withHsPackage $ \cabalFile -> do
- pkgId <- expr $ pkgIdentifier cabalFile
- mconcat [ arg "-hide-all-packages"
- , arg "-no-user-package-db"
- , bootPackageDatabaseArgs
- , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
- , map ("-package-id " ++) <$> getPkgDataList DepIds ]
-
-includeGhcArgs :: Args
-includeGhcArgs = do
- pkg <- getPackage
- path <- getBuildPath
- root <- getBuildRoot
- context <- getContext
- srcDirs <- getPkgDataList SrcDirs
- autogen <- expr $ autogenPath context
- mconcat [ arg "-i"
- , arg $ "-i" ++ path
- , arg $ "-i" ++ autogen
- , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ]
- , cIncludeArgs
- , arg $ "-I" ++ root -/- generatedDir
- , arg $ "-optc-I" ++ root -/- generatedDir
- , (not $ nonCabalContext context) ?
- pure [ "-optP-include", "-optP" ++ autogen -/- "cabal_macros.h" ] ]
diff --git a/hadrian/src/Settings/Builders/GhcCabal.hs b/hadrian/src/Settings/Builders/GhcCabal.hs
deleted file mode 100644
index bfb84a76ec..0000000000
--- a/hadrian/src/Settings/Builders/GhcCabal.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-module Settings.Builders.GhcCabal (
- ghcCabalBuilderArgs
- ) where
-
-import Hadrian.Haskell.Cabal
-
-import Context
-import Flavour
-import Settings.Builders.Common
-
-ghcCabalBuilderArgs :: Args
-ghcCabalBuilderArgs = builder GhcCabal ? do
- verbosity <- expr getVerbosity
- top <- expr topDirectory
- path <- getBuildPath
- notStage0 ? expr (need inplaceLibCopyTargets)
- mconcat [ arg "configure"
- , arg =<< pkgPath <$> getPackage
- , arg $ top -/- path
- , withStaged $ Ghc CompileHs
- , withStaged (GhcPkg Update)
- , bootPackageDatabaseArgs
- , libraryArgs
- , configureArgs
- , bootPackageConstraints
- , withStaged $ Cc CompileC
- , notStage0 ? with Ld
- , withStaged (Ar Pack)
- , with Alex
- , with Happy
- , 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?
-libraryArgs :: Args
-libraryArgs = do
- ways <- getLibraryWays
- withGhci <- expr ghcWithInterpreter
- dynPrograms <- dynamicGhcPrograms <$> expr flavour
- pure [ if vanilla `elem` ways
- then "--enable-library-vanilla"
- else "--disable-library-vanilla"
- , if vanilla `elem` ways && withGhci && not dynPrograms
- then "--enable-library-for-ghci"
- else "--disable-library-for-ghci"
- , if profiling `elem` ways
- then "--enable-library-profiling"
- else "--disable-library-profiling"
- , if dynamic `elem` ways
- then "--enable-shared"
- else "--disable-shared" ]
-
--- TODO: LD_OPTS?
-configureArgs :: Args
-configureArgs = do
- top <- expr topDirectory
- root <- getBuildRoot
- let conf key expr = do
- values <- unwords <$> expr
- not (null values) ?
- arg ("--configure-option=" ++ key ++ "=" ++ values)
- cFlags = mconcat [ remove ["-Werror"] cArgs
- , getStagedSettingList ConfCcArgs
- , arg $ "-I" ++ top -/- root -/- generatedDir ]
- ldFlags = ldArgs <> (getStagedSettingList ConfGccLinkerArgs)
- cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs)
- cldFlags <- unwords <$> (cFlags <> ldFlags)
- mconcat
- [ conf "CFLAGS" cFlags
- , conf "LDFLAGS" ldFlags
- , conf "CPPFLAGS" cppFlags
- , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags)
- , conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir
- , conf "--with-iconv-libraries" $ arg =<< getSetting IconvLibDir
- , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir
- , 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 ]
-
-bootPackageConstraints :: Args
-bootPackageConstraints = stage0 ? do
- bootPkgs <- expr $ stagePackages Stage0
- let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
- constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do
- version <- traverse pkgVersion (pkgCabalFile pkg)
- return $ fmap ((pkgName pkg ++ " == ") ++) version
- pure $ concat [ ["--constraint", c] | c <- constraints ]
-
-cppArgs :: Args
-cppArgs = do
- root <- getBuildRoot
- arg $ "-I" ++ root -/- generatedDir
-
-withBuilderKey :: Builder -> String
-withBuilderKey b = case b of
- Ar _ _ -> "--with-ar="
- Ld -> "--with-ld="
- Cc _ _ -> "--with-gcc="
- Ghc _ _ -> "--with-ghc="
- Alex -> "--with-alex="
- Happy -> "--with-happy="
- GhcPkg _ _ -> "--with-ghc-pkg="
- _ -> error $ "withBuilderKey: not supported builder " ++ show b
-
--- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
-with :: Builder -> Args
-with b = do
- path <- getBuilderPath b
- if (null path) then mempty else do
- top <- expr topDirectory
- expr $ needBuilder b
- arg $ withBuilderKey b ++ unifyPath (top </> path)
-
-withStaged :: (Stage -> Builder) -> Args
-withStaged sb = with . sb =<< getStage
-
diff --git a/hadrian/src/Settings/Builders/GhcPkg.hs b/hadrian/src/Settings/Builders/GhcPkg.hs
deleted file mode 100644
index ba705c6892..0000000000
--- a/hadrian/src/Settings/Builders/GhcPkg.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Settings.Builders.GhcPkg (ghcPkgBuilderArgs) where
-
-import Settings.Builders.Common
-
-ghcPkgBuilderArgs :: Args
-ghcPkgBuilderArgs = mconcat
- [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ]
-
- , builder (GhcPkg Update) ? do
- verbosity <- expr getVerbosity
- context <- getContext
- config <- expr $ pkgInplaceConfig context
- mconcat [ arg "update"
- , arg "--force"
- , verbosity < Chatty ? arg "-v0"
- , bootPackageDatabaseArgs
- , arg config ] ]
diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs
deleted file mode 100644
index b3810476ad..0000000000
--- a/hadrian/src/Settings/Builders/Haddock.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-module Settings.Builders.Haddock (haddockBuilderArgs) where
-
-import Hadrian.Utilities
-import Hadrian.Haskell.Cabal
-
-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."
-
-haddockBuilderArgs :: Args
-haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat
- [ builder (Haddock BuildIndex) ? do
- output <- getOutput
- inputs <- getInputs
- mconcat
- [ arg "--gen-index"
- , arg "--gen-contents"
- , arg "-o", arg $ takeDirectory output
- , arg "-t", arg "Haskell Hierarchical Libraries"
- , arg "-p", arg "libraries/prologue.txt"
- , pure [ "--read-interface="
- ++ (takeFileName . takeDirectory) haddock
- ++ "," ++ haddock | haddock <- inputs ] ]
-
- , builder (Haddock BuildPackage) ? do
- output <- getOutput
- pkg <- getPackage
- path <- getBuildPath
- version <- expr $ pkgVersion cabalFile
- synopsis <- expr $ pkgSynopsis cabalFile
- deps <- getPkgDataList DepNames
- haddocks <- expr . haddockDependencies =<< getContext
- hVersion <- expr $ pkgVersion (unsafePkgCabalFile haddock) -- TODO: improve
- ghcOpts <- haddockGhcArgs
- mconcat
- [ arg $ "--odir=" ++ takeDirectory output
- , arg "--verbosity=0"
- , arg "--no-tmp-comp-dir"
- , arg $ "--dump-interface=" ++ output
- , arg "--html"
- , arg "--hyperlinked-source"
- , arg "--hoogle"
- , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version
- ++ ": " ++ synopsis
- , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt"
- , arg $ "--optghc=-D__HADDOCK_VERSION__="
- ++ show (versionToInt hVersion)
- , map ("--hide=" ++) <$> getPkgDataList HiddenModules
- , pure [ "--read-interface=../" ++ dep
- ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME},"
- ++ haddock | (dep, haddock) <- zip deps haddocks ]
- , pure [ "--optghc=" ++ opt | opt <- ghcOpts ]
- , getInputs
- , arg "+RTS"
- , arg $ "-t" ++ path -/- "haddock.t"
- , arg "--machine-readable"
- , arg "-RTS" ] ]
diff --git a/hadrian/src/Settings/Builders/Happy.hs b/hadrian/src/Settings/Builders/Happy.hs
deleted file mode 100644
index 5ffb2614cc..0000000000
--- a/hadrian/src/Settings/Builders/Happy.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Settings.Builders.Happy (happyBuilderArgs) where
-
-import Settings.Builders.Common
-
-happyBuilderArgs :: Args
-happyBuilderArgs = builder Happy ? mconcat [ arg "-agc"
- , arg "--strict"
- , arg =<< getInput
- , arg "-o", arg =<< getOutput ]
diff --git a/hadrian/src/Settings/Builders/HsCpp.hs b/hadrian/src/Settings/Builders/HsCpp.hs
deleted file mode 100644
index aeb5255990..0000000000
--- a/hadrian/src/Settings/Builders/HsCpp.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Settings.Builders.HsCpp (hsCppBuilderArgs) where
-
-import Settings.Builders.Common
-
-hsCppBuilderArgs :: Args
-hsCppBuilderArgs = builder HsCpp ? do
- stage <- getStage
- root <- getBuildRoot
- ghcPath <- expr $ buildPath (vanillaContext stage compiler)
- mconcat [ getSettingList HsCppArgs
- , arg "-P"
- , arg "-Iincludes"
- , arg $ "-I" ++ root -/- generatedDir
- , arg $ "-I" ++ ghcPath
- , arg "-x", arg "c"
- , arg =<< getInput ]
diff --git a/hadrian/src/Settings/Builders/Hsc2Hs.hs b/hadrian/src/Settings/Builders/Hsc2Hs.hs
deleted file mode 100644
index 6185f6bec3..0000000000
--- a/hadrian/src/Settings/Builders/Hsc2Hs.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where
-
-import Settings.Builders.Common
-
-hsc2hsBuilderArgs :: Args
-hsc2hsBuilderArgs = builder Hsc2Hs ? do
- stage <- getStage
- ccPath <- getBuilderPath $ Cc CompileC stage
- gmpDir <- getSetting GmpIncludeDir
- top <- expr topDirectory
- hArch <- getSetting HostArch
- hOs <- getSetting HostOs
- tArch <- getSetting TargetArch
- tOs <- getSetting TargetOs
- version <- if stage == Stage0
- then expr ghcCanonVersion
- else getSetting ProjectVersionInt
- mconcat [ arg $ "--cc=" ++ ccPath
- , arg $ "--ld=" ++ ccPath
- , notM windowsHost ? arg "--cross-safe"
- , pure $ map ("-I" ++) (words gmpDir)
- , map ("--cflag=" ++) <$> getCFlags
- , map ("--lflag=" ++) <$> getLFlags
- , notStage0 ? crossCompiling ? arg "--cross-compile"
- , stage0 ? arg ("--cflag=-D" ++ hArch ++ "_HOST_ARCH=1")
- , stage0 ? arg ("--cflag=-D" ++ hOs ++ "_HOST_OS=1" )
- , 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 $ "-I" ++ top -/- "inplace/lib/include/"
- , arg =<< getInput
- , arg "-o", arg =<< getOutput ]
-
-getCFlags :: Expr [String]
-getCFlags = do
- context <- getContext
- autogen <- expr $ autogenPath context
- mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
- , getStagedSettingList ConfCppArgs
- , cIncludeArgs
- , getPkgDataList CppArgs
- , getPkgDataList DepCcArgs
- , cWarnings
- , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
-
-getLFlags :: Expr [String]
-getLFlags = do
- libDirs <- getPkgDataList DepLibDirs
- extraLibs <- getPkgDataList DepExtraLibs
- mconcat [ getStagedSettingList ConfGccLinkerArgs
- , ldArgs
- , getPkgDataList LdArgs
- , pure [ "-L" ++ unifyPath dir | dir <- libDirs ]
- , pure [ "-l" ++ unifyPath dir | dir <- extraLibs ]
- , getPkgDataList DepLdArgs ]
diff --git a/hadrian/src/Settings/Builders/Ld.hs b/hadrian/src/Settings/Builders/Ld.hs
deleted file mode 100644
index 2715bbb20c..0000000000
--- a/hadrian/src/Settings/Builders/Ld.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Settings.Builders.Ld (ldBuilderArgs) where
-
-import Settings.Builders.Common
-
-ldBuilderArgs :: Args
-ldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs
- , arg "-r"
- , arg "-o", arg =<< getOutput
- , getInputs ]
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
deleted file mode 100644
index cc350df508..0000000000
--- a/hadrian/src/Settings/Builders/Make.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Settings.Builders.Make (makeBuilderArgs) where
-
-import Rules.Gmp
-import Rules.Libffi
-import Settings.Builders.Common
-
-makeBuilderArgs :: Args
-makeBuilderArgs = do
- threads <- shakeThreads <$> expr getShakeOptions
- gmpPath <- expr gmpBuildPath
- libffiPath <- expr libffiBuildPath
- let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
- mconcat
- [ builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t]
- , builder (Make libffiPath ) ? pure ["MAKEFLAGS=-j" ++ t, "install"]
- , builder (Make "testsuite/tests") ? pure ["THREADS=" ++ t, "fast"] ]
diff --git a/hadrian/src/Settings/Builders/Xelatex.hs b/hadrian/src/Settings/Builders/Xelatex.hs
deleted file mode 100644
index 5623284ed5..0000000000
--- a/hadrian/src/Settings/Builders/Xelatex.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Settings.Builders.Xelatex (xelatexBuilderArgs) where
-
-import Settings.Builders.Common
-
-xelatexBuilderArgs :: Args
-xelatexBuilderArgs = builder Xelatex ? mconcat [ arg "-halt-on-error"
- , arg =<< getInput ]
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
deleted file mode 100644
index dc58f22160..0000000000
--- a/hadrian/src/Settings/Default.hs
+++ /dev/null
@@ -1,173 +0,0 @@
-module Settings.Default (
- SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
- defaultArgs, defaultLibraryWays, defaultRtsWays,
- 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 Oracles.PackageData
-import Settings
-import Settings.Builders.Alex
-import Settings.Builders.DeriveConstants
-import Settings.Builders.Cc
-import Settings.Builders.Configure
-import Settings.Builders.GenPrimopCode
-import Settings.Builders.Ghc
-import Settings.Builders.GhcCabal
-import Settings.Builders.GhcPkg
-import Settings.Builders.Haddock
-import Settings.Builders.Happy
-import Settings.Builders.Hsc2Hs
-import Settings.Builders.HsCpp
-import Settings.Builders.Ld
-import Settings.Builders.Make
-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.Rts
-import Settings.Packages.RunGhc
-import Settings.Warnings
-
--- TODO: Move C source arguments here
--- | Default and package-specific source arguments.
-data SourceArgs = SourceArgs
- { hsDefault :: Args
- , hsLibrary :: Args
- , hsCompiler :: Args
- , hsGhc :: Args }
-
--- | Concatenate source arguments in appropriate order.
-sourceArgs :: SourceArgs -> Args
-sourceArgs SourceArgs {..} = builder Ghc ? mconcat
- [ hsDefault
- , getPkgDataList HsArgs
- , libraryPackage ? hsLibrary
- , package compiler ? hsCompiler
- , package ghc ? hsGhc ]
-
--- | All default command line arguments.
-defaultArgs :: Args
-defaultArgs = mconcat
- [ defaultBuilderArgs
- , sourceArgs defaultSourceArgs
- , defaultPackageArgs ]
-
--- | Default source arguments, e.g. optimisation settings.
-defaultSourceArgs :: SourceArgs
-defaultSourceArgs = SourceArgs
- { hsDefault = mconcat [ stage0 ? arg "-O"
- , notStage0 ? arg "-O2"
- , arg "-H32m" ]
- , hsLibrary = mempty
- , hsCompiler = mempty
- , hsGhc = mempty }
-
--- | Default build ways for library packages:
--- * We always build 'vanilla' way.
--- * We build 'profiling' way when stage > Stage0.
--- * We build 'dynamic' way when stage > Stage0 and the platform supports it.
-defaultLibraryWays :: Ways
-defaultLibraryWays = mconcat
- [ pure [vanilla]
- , notStage0 ? pure [profiling]
- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]
-
--- | Default build ways for the RTS.
-defaultRtsWays :: Ways
-defaultRtsWays = do
- ways <- getLibraryWays
- mconcat
- [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ]
- , (profiling `elem` ways) ? pure [threadedProfiling]
- , (dynamic `elem` ways) ?
- pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic
- , loggingDynamic, threadedLoggingDynamic ] ]
-
--- Please update doc/flavours.md when changing the default build flavour.
--- | Default build flavour. Other build flavours are defined in modules
--- @Settings.Flavours.*@. Users can add new build flavours in "UserSettings".
-defaultFlavour :: Flavour
-defaultFlavour = Flavour
- { name = "default"
- , args = defaultArgs
- , packages = defaultPackages
- , integerLibrary = (\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple
- , libraryWays = defaultLibraryWays
- , rtsWays = defaultRtsWays
- , splitObjects = defaultSplitObjects
- , dynamicGhcPrograms = False
- , ghciWithDebugger = False
- , ghcProfiled = False
- , ghcDebugged = False }
-
--- | Default condition for building split objects.
-defaultSplitObjects :: Predicate
-defaultSplitObjects = do
- goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
- pkg <- getPackage
- supported <- expr supportsSplitObjects
- split <- expr cmdSplitObjects
- let goodPackage = isLibrary pkg && pkg /= compiler && pkg /= rts
- return $ split && goodStage && goodPackage && supported
-
--- | All 'Builder'-dependent command line arguments.
-defaultBuilderArgs :: Args
-defaultBuilderArgs = mconcat
- -- GHC-specific builders:
- [ alexBuilderArgs
- , ccBuilderArgs
- , configureBuilderArgs
- , deriveConstantsBuilderArgs
- , genPrimopCodeBuilderArgs
- , ghcBuilderArgs
- , ghcCabalBuilderArgs
- , ghcPkgBuilderArgs
- , haddockBuilderArgs
- , happyBuilderArgs
- , hsc2hsBuilderArgs
- , hsCppBuilderArgs
- , ldBuilderArgs
- , makeBuilderArgs
- , xelatexBuilderArgs
- -- Generic builders from the Hadrian library:
- , builder (Ar Pack ) ? Hadrian.Builder.Ar.args Pack
- , builder (Ar Unpack ) ? Hadrian.Builder.Ar.args Unpack
- , builder (Sphinx Html ) ? Hadrian.Builder.Sphinx.args Html
- , builder (Sphinx Latex) ? Hadrian.Builder.Sphinx.args Latex
- , builder (Sphinx Man ) ? Hadrian.Builder.Sphinx.args Man
- , builder (Tar Create ) ? Hadrian.Builder.Tar.args Create
- , builder (Tar Extract ) ? Hadrian.Builder.Tar.args Extract ]
-
--- | All 'Package'-dependent command line arguments.
-defaultPackageArgs :: Args
-defaultPackageArgs = mconcat
- [ basePackageArgs
- , cabalPackageArgs
- , compilerPackageArgs
- , ghcCabalPackageArgs
- , ghciPackageArgs
- , ghcPackageArgs
- , ghcPkgPackageArgs
- , ghcPrimPackageArgs
- , haddockPackageArgs
- , haskelinePackageArgs
- , integerGmpPackageArgs
- , rtsPackageArgs
- , runGhcPackageArgs
- , warningArgs ]
diff --git a/hadrian/src/Settings/Default.hs-boot b/hadrian/src/Settings/Default.hs-boot
deleted file mode 100644
index 468c5cae3e..0000000000
--- a/hadrian/src/Settings/Default.hs-boot
+++ /dev/null
@@ -1,20 +0,0 @@
-module Settings.Default (
- SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
- defaultArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultSplitObjects
- ) where
-
-import Flavour
-import Expression
-
-data SourceArgs = SourceArgs
- { hsDefault :: Args
- , hsLibrary :: Args
- , hsCompiler :: Args
- , hsGhc :: Args }
-
-sourceArgs :: SourceArgs -> Args
-
-defaultBuilderArgs, defaultPackageArgs, defaultArgs :: Args
-defaultLibraryWays, defaultRtsWays :: Ways
-defaultFlavour :: Flavour
-defaultSplitObjects :: Predicate
diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs
deleted file mode 100644
index 5919026cb0..0000000000
--- a/hadrian/src/Settings/Flavours/Development.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module Settings.Flavours.Development (developmentFlavour) where
-
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-developmentFlavour :: Stage -> Flavour
-developmentFlavour ghcStage = defaultFlavour
- { name = "devel" ++ show (fromEnum ghcStage)
- , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs }
-
-developmentArgs :: Stage -> Args
-developmentArgs ghcStage = do
- stage <- getStage
- sourceArgs SourceArgs
- { hsDefault = pure ["-O", "-H64m"]
- , hsLibrary = notStage0 ? arg "-dcore-lint"
- , hsCompiler = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"]
- , hsGhc = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"] }
diff --git a/hadrian/src/Settings/Flavours/Performance.hs b/hadrian/src/Settings/Flavours/Performance.hs
deleted file mode 100644
index 64ab4bce9d..0000000000
--- a/hadrian/src/Settings/Flavours/Performance.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Settings.Flavours.Performance (performanceFlavour) where
-
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-performanceFlavour :: Flavour
-performanceFlavour = defaultFlavour
- { name = "perf"
- , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs }
-
-performanceArgs :: Args
-performanceArgs = sourceArgs SourceArgs
- { hsDefault = pure ["-O", "-H64m"]
- , hsLibrary = notStage0 ? arg "-O2"
- , hsCompiler = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"]
- , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] }
diff --git a/hadrian/src/Settings/Flavours/Profiled.hs b/hadrian/src/Settings/Flavours/Profiled.hs
deleted file mode 100644
index d56cc10055..0000000000
--- a/hadrian/src/Settings/Flavours/Profiled.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Settings.Flavours.Profiled (profiledFlavour) where
-
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-profiledFlavour :: Flavour
-profiledFlavour = defaultFlavour
- { name = "prof"
- , args = defaultBuilderArgs <> profiledArgs <> defaultPackageArgs
- , ghcProfiled = True }
-
-profiledArgs :: Args
-profiledArgs = sourceArgs SourceArgs
- { hsDefault = pure ["-O0", "-H64m"]
- , hsLibrary = notStage0 ? arg "-O"
- , hsCompiler = arg "-O"
- , hsGhc = arg "-O" }
diff --git a/hadrian/src/Settings/Flavours/Quick.hs b/hadrian/src/Settings/Flavours/Quick.hs
deleted file mode 100644
index 99dade9bf1..0000000000
--- a/hadrian/src/Settings/Flavours/Quick.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Settings.Flavours.Quick (quickFlavour) where
-
-import Expression
-import Flavour
-import Oracles.Flag
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-quickFlavour :: Flavour
-quickFlavour = defaultFlavour
- { name = "quick"
- , args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs
- , libraryWays = mconcat
- [ pure [vanilla]
- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
-
-quickArgs :: Args
-quickArgs = sourceArgs SourceArgs
- { hsDefault = pure ["-O0", "-H64m"]
- , hsLibrary = notStage0 ? arg "-O"
- , hsCompiler = stage0 ? arg "-O"
- , hsGhc = stage0 ? arg "-O" }
diff --git a/hadrian/src/Settings/Flavours/QuickCross.hs b/hadrian/src/Settings/Flavours/QuickCross.hs
deleted file mode 100644
index 3d0c410bea..0000000000
--- a/hadrian/src/Settings/Flavours/QuickCross.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Settings.Flavours.QuickCross (quickCrossFlavour) where
-
-import Expression
-import Flavour
-import Oracles.Flag
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-quickCrossFlavour :: Flavour
-quickCrossFlavour = defaultFlavour
- { name = "quick-cross"
- , args = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs
- , libraryWays = mconcat
- [ pure [vanilla]
- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
-
-quickCrossArgs :: Args
-quickCrossArgs = sourceArgs SourceArgs
- { hsDefault = pure ["-O0", "-H64m"]
- , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvm" ]
- , hsCompiler = stage0 ? arg "-O"
- , hsGhc = mconcat
- [ stage0 ? arg "-O"
- , stage1 ? mconcat [ arg "-O0", arg "-fllvm" ] ] }
diff --git a/hadrian/src/Settings/Flavours/Quickest.hs b/hadrian/src/Settings/Flavours/Quickest.hs
deleted file mode 100644
index a9dfb7087f..0000000000
--- a/hadrian/src/Settings/Flavours/Quickest.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Settings.Flavours.Quickest (quickestFlavour) where
-
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-quickestFlavour :: Flavour
-quickestFlavour = defaultFlavour
- { name = "quickest"
- , args = defaultBuilderArgs <> quickestArgs <> defaultPackageArgs
- , libraryWays = pure [vanilla]
- , rtsWays = quickestRtsWays }
-
-quickestArgs :: Args
-quickestArgs = sourceArgs SourceArgs
- { hsDefault = pure ["-O0", "-H64m"]
- , hsLibrary = mempty
- , hsCompiler = stage0 ? arg "-O"
- , hsGhc = stage0 ? arg "-O" }
-
-quickestRtsWays :: Ways
-quickestRtsWays = pure [vanilla, threaded]
diff --git a/hadrian/src/Settings/Packages/Base.hs b/hadrian/src/Settings/Packages/Base.hs
deleted file mode 100644
index 2e0ced4c26..0000000000
--- a/hadrian/src/Settings/Packages/Base.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Settings.Packages.Base (basePackageArgs) where
-
-import Expression
-import Settings
-
-basePackageArgs :: Args
-basePackageArgs = package base ? do
- integerLibraryName <- pkgName <$> getIntegerPackage
- mconcat [ builder GhcCabal ? arg ("--flags=" ++ integerLibraryName)
- -- This fixes the 'unknown symbol stat' issue.
- -- See: https://github.com/snowleopard/hadrian/issues/259.
- , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
diff --git a/hadrian/src/Settings/Packages/Cabal.hs b/hadrian/src/Settings/Packages/Cabal.hs
deleted file mode 100644
index c01be4b3ed..0000000000
--- a/hadrian/src/Settings/Packages/Cabal.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Settings.Packages.Cabal where
-
-import Expression
-
-cabalPackageArgs :: Args
-cabalPackageArgs = 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"
diff --git a/hadrian/src/Settings/Packages/Compiler.hs b/hadrian/src/Settings/Packages/Compiler.hs
deleted file mode 100644
index 6b329d7b4f..0000000000
--- a/hadrian/src/Settings/Packages/Compiler.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Settings.Packages.Compiler (compilerPackageArgs) where
-
-import Base
-import Expression
-import Flavour
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-
-compilerPackageArgs :: Args
-compilerPackageArgs = package compiler ? do
- stage <- getStage
- rtsWays <- getRtsWays
- path <- getBuildPath
- 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 ? 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"
- , (threaded `elem` rtsWays) ?
- notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
- , ghcWithNativeCodeGen ? arg "--flags=ncg"
- , ghcWithInterpreter ?
- notStage0 ? arg "--flags=ghci"
- , crossCompiling ? arg "-f-terminfo"
- , 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 (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
diff --git a/hadrian/src/Settings/Packages/Ghc.hs b/hadrian/src/Settings/Packages/Ghc.hs
deleted file mode 100644
index d7b1d78ddd..0000000000
--- a/hadrian/src/Settings/Packages/Ghc.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Settings.Packages.Ghc (ghcPackageArgs) where
-
-import Expression
-import Oracles.Setting
-import Oracles.Flag (crossCompiling)
-
-ghcPackageArgs :: Args
-ghcPackageArgs = package ghc ? do
- stage <- getStage
- path <- expr $ buildPath (vanillaContext stage compiler)
- mconcat [ builder Ghc ? arg ("-I" ++ path)
- , builder GhcCabal ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci"
- , builder GhcCabal ? crossCompiling ? arg "-f-terminfo" ]
diff --git a/hadrian/src/Settings/Packages/GhcCabal.hs b/hadrian/src/Settings/Packages/GhcCabal.hs
deleted file mode 100644
index c88617b97f..0000000000
--- a/hadrian/src/Settings/Packages/GhcCabal.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Settings.Packages.GhcCabal (ghcCabalPackageArgs) where
-
-import Hadrian.Haskell.Cabal
-
-import Base
-import Expression
-import Utilities
-
-ghcCabalPackageArgs :: Args
-ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do
- cabalDeps <- expr $ stage1Dependencies cabal
- let bootDeps = cabalDeps \\ [integerGmp, integerSimple, mtl, parsec, text]
- cabalVersion <- expr $ pkgVersion (unsafePkgCabalFile cabal) -- TODO: improve
- mconcat
- [ pure [ "-package " ++ pkgName pkg | pkg <- bootDeps ]
- , arg "--make"
- , arg "-j"
- , pure ["-Wall", "-fno-warn-unused-imports", "-fno-warn-warnings-deprecations"]
- , arg ("-DCABAL_VERSION=" ++ replace "." "," cabalVersion)
- , arg "-DCABAL_PARSEC"
- , arg "-DBOOTSTRAPPING"
- , arg "-DMIN_VERSION_binary_0_8_0"
- , arg "libraries/text/cbits/cbits.c"
- , arg "-ilibraries/Cabal/Cabal"
- , arg "-ilibraries/binary/src"
- , arg "-ilibraries/filepath"
- , arg "-ilibraries/hpc"
- , arg "-ilibraries/mtl"
- , arg "-ilibraries/text"
- , arg "-Ilibraries/text/include"
- , arg "-ilibraries/parsec" ]
-
diff --git a/hadrian/src/Settings/Packages/GhcPkg.hs b/hadrian/src/Settings/Packages/GhcPkg.hs
deleted file mode 100644
index a13a9dab7e..0000000000
--- a/hadrian/src/Settings/Packages/GhcPkg.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Settings.Packages.GhcPkg (ghcPkgPackageArgs) where
-
-import Expression
-import Oracles.Flag (crossCompiling)
-
-ghcPkgPackageArgs :: Args
-ghcPkgPackageArgs = package ghcPkg ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo"
diff --git a/hadrian/src/Settings/Packages/GhcPrim.hs b/hadrian/src/Settings/Packages/GhcPrim.hs
deleted file mode 100644
index aed8f2ff73..0000000000
--- a/hadrian/src/Settings/Packages/GhcPrim.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Settings.Packages.GhcPrim (ghcPrimPackageArgs) where
-
-import Oracles.Flag
-import Expression
-
-ghcPrimPackageArgs :: Args
-ghcPrimPackageArgs = package ghcPrim ? mconcat
- [ builder GhcCabal ? arg "--flag=include-ghc-prim"
-
- , builder (Cc CompileC) ?
- (not <$> flag GccIsClang) ?
- input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ]
diff --git a/hadrian/src/Settings/Packages/Ghci.hs b/hadrian/src/Settings/Packages/Ghci.hs
deleted file mode 100644
index 47e7d38deb..0000000000
--- a/hadrian/src/Settings/Packages/Ghci.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Settings.Packages.Ghci (ghciPackageArgs) where
-
-import Expression
-
-ghciPackageArgs :: Args
-ghciPackageArgs = package ghci ? notStage0 ? builder GhcCabal ? arg "--flags=ghci"
diff --git a/hadrian/src/Settings/Packages/Haddock.hs b/hadrian/src/Settings/Packages/Haddock.hs
deleted file mode 100644
index c8d667ecb4..0000000000
--- a/hadrian/src/Settings/Packages/Haddock.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Settings.Packages.Haddock (haddockPackageArgs) where
-
-import Expression
-
-haddockPackageArgs :: Args
-haddockPackageArgs = package haddock ?
- builder GhcCabal ? pure ["--flag", "in-ghc-tree"]
diff --git a/hadrian/src/Settings/Packages/Haskeline.hs b/hadrian/src/Settings/Packages/Haskeline.hs
deleted file mode 100644
index 254c6b704c..0000000000
--- a/hadrian/src/Settings/Packages/Haskeline.hs
+++ /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"
diff --git a/hadrian/src/Settings/Packages/IntegerGmp.hs b/hadrian/src/Settings/Packages/IntegerGmp.hs
deleted file mode 100644
index 7c2b5f635b..0000000000
--- a/hadrian/src/Settings/Packages/IntegerGmp.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where
-
-import Base
-import Expression
-import Oracles.Setting
-import Rules.Gmp
-
--- TODO: Is this needed?
--- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
--- libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
--- endif
-integerGmpPackageArgs :: Args
-integerGmpPackageArgs = package integerGmp ? do
- path <- expr gmpBuildPath
- let includeGmp = "-I" ++ path -/- "include"
- gmpIncludeDir <- getSetting GmpIncludeDir
- gmpLibDir <- getSetting GmpLibDir
- mconcat [ builder Cc ? arg includeGmp
-
- , builder GhcCabal ? mconcat
- [ (null gmpIncludeDir && null gmpLibDir) ?
- arg "--configure-option=--with-intree-gmp"
- , arg ("--configure-option=CFLAGS=" ++ includeGmp)
- , arg ("--gcc-options=" ++ includeGmp) ] ]
diff --git a/hadrian/src/Settings/Packages/Rts.hs b/hadrian/src/Settings/Packages/Rts.hs
deleted file mode 100644
index cdc89dae56..0000000000
--- a/hadrian/src/Settings/Packages/Rts.hs
+++ /dev/null
@@ -1,224 +0,0 @@
-module Settings.Packages.Rts (
- rtsContext, rtsBuildPath, rtsConfIn, rtsPackageArgs, rtsLibffiLibrary
- ) where
-
-import Base
-import Expression
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-
--- | RTS is considered a Stage1 package. This determines RTS build directory.
-rtsContext :: Context
-rtsContext = vanillaContext Stage1 rts
-
--- | Path to the RTS build directory.
-rtsBuildPath :: Action FilePath
-rtsBuildPath = buildPath rtsContext
-
--- | Path to RTS package configuration file, to be processed by HsCpp.
-rtsConfIn :: FilePath
-rtsConfIn = pkgPath rts -/- "package.conf.in"
-
--- These numbers can be found at:
--- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
--- If we're compiling on windows, enforce that we only support Vista SP1+
--- Adding this here means it doesn't have to be done in individual .c files
--- and also centralizes the versioning.
--- | Minimum supported Windows version.
-windowsVersion :: String
-windowsVersion = "0x06000100"
-
-libffiLibraryName :: Action FilePath
-libffiLibraryName = do
- useSystemFfi <- flag UseSystemFfi
- windows <- windowsHost
- return $ case (useSystemFfi, windows) of
- (True , False) -> "ffi"
- (False, False) -> "Cffi"
- (_ , True ) -> "Cffi-6"
-
-rtsLibffiLibrary :: Way -> Action FilePath
-rtsLibffiLibrary way = do
- name <- libffiLibraryName
- suf <- libsuf way
- rtsPath <- rtsBuildPath
- return $ rtsPath -/- "lib" ++ name ++ suf
-
--- Compile various performance-critical pieces *without* -fPIC -dynamic
--- even when building a shared library. If we don't do this, then the
--- GC runs about 50% slower on x86 due to the overheads of PIC. The
--- cost of doing this is a little runtime linking and less sharing, but
--- not much.
---
--- On x86_64 this doesn't work, because all objects in a shared library
--- must be compiled with -fPIC (since the 32-bit relocations generated
--- by the default small memory can't be resolved at runtime). So we
--- only do this on i386.
---
--- This apparently doesn't work on OS X (Darwin) nor on Solaris.
--- On Darwin we get errors of the form
---
--- ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast from rts/dist/build/Apply.dyn_o not allowed in slidable image
---
--- and lots of these warnings:
---
--- ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image from loading in dyld shared cache
---
--- On Solaris we get errors like:
---
--- Text relocation remains referenced
--- against symbol offset in file
--- .rodata (section) 0x11 rts/dist/build/Apply.dyn_o
--- ...
--- ld: fatal: relocations remain against allocatable but non-writable sections
--- collect2: ld returned 1 exit status
-speedHack :: Action Bool
-speedHack = do
- i386 <- anyTargetArch ["i386"]
- goodOS <- not <$> anyTargetOs ["darwin", "solaris2"]
- return $ i386 && goodOS
-
-rtsPackageArgs :: Args
-rtsPackageArgs = package rts ? do
- projectVersion <- getSetting ProjectVersion
- hostPlatform <- getSetting HostPlatform
- hostArch <- getSetting HostArch
- hostOs <- getSetting HostOs
- hostVendor <- getSetting HostVendor
- buildPlatform <- getSetting BuildPlatform
- buildArch <- getSetting BuildArch
- buildOs <- getSetting BuildOs
- buildVendor <- getSetting BuildVendor
- targetPlatform <- getSetting TargetPlatform
- targetArch <- getSetting TargetArch
- targetOs <- getSetting TargetOs
- targetVendor <- getSetting TargetVendor
- ghcUnreg <- expr $ yesNo <$> flag GhcUnregisterised
- ghcEnableTNC <- expr $ yesNo <$> ghcEnableTablesNextToCode
- way <- getWay
- path <- getBuildPath
- top <- expr topDirectory
- libffiName <- expr libffiLibraryName
- ffiIncludeDir <- getSetting FfiIncludeDir
- ffiLibraryDir <- getSetting FfiLibDir
- ghclibDir <- expr installGhcLibDir
- destDir <- expr getDestDir
- let cArgs = mconcat
- [ arg "-Irts"
- , rtsWarnings
- , arg $ "-I" ++ path
- , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
- , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
- -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
- -- requires that functions are inlined to work as expected. Inlining
- -- only happens for optimised builds. Otherwise we can assume that
- -- there is a non-inlined variant to use instead. But RTS does not
- -- provide non-inlined alternatives and hence needs the function to
- -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
- , arg "-O2"
-
- , Debug `wayUnit` way ? arg "-DDEBUG"
- , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY"
- , Profiling `wayUnit` way ? arg "-DPROFILING"
- , Threaded `wayUnit` way ? arg "-DTHREADED_RTS"
-
- , inputs ["//RtsMessages.c", "//Trace.c"] ?
- arg ("-DProjectVersion=" ++ show projectVersion)
-
- , input "//RtsUtils.c" ? pure
- [ "-DProjectVersion=" ++ show projectVersion
- , "-DHostPlatform=" ++ show hostPlatform
- , "-DHostArch=" ++ show hostArch
- , "-DHostOS=" ++ show hostOs
- , "-DHostVendor=" ++ show hostVendor
- , "-DBuildPlatform=" ++ show buildPlatform
- , "-DBuildArch=" ++ show buildArch
- , "-DBuildOS=" ++ show buildOs
- , "-DBuildVendor=" ++ show buildVendor
- , "-DTargetPlatform=" ++ show targetPlatform
- , "-DTargetArch=" ++ show targetArch
- , "-DTargetOS=" ++ show targetOs
- , "-DTargetVendor=" ++ show targetVendor
- , "-DGhcUnregisterised=" ++ show ghcUnreg
- , "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]
-
- , inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops"
-
- , speedHack ?
- inputs [ "//Evac.c", "//Evac_thr.c"
- , "//Scav.c", "//Scav_thr.c"
- , "//Compact.c", "//GC.c" ] ? arg "-fno-PIC"
- -- -static is also necessary for these bits, otherwise the NCG
- -- generates dynamic references:
- , speedHack ?
- inputs [ "//Updates.c", "//StgMiscClosures.c"
- , "//PrimOps.c", "//Apply.c"
- , "//AutoApply.c" ] ? pure ["-fno-PIC", "-static"]
-
- -- inlining warnings happen in Compact
- , inputs ["//Compact.c"] ? arg "-Wno-inline"
-
- -- emits warnings about call-clobbered registers on x86_64
- , inputs [ "//RetainerProfile.c", "//StgCRun.c"
- , "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w"
- , inputs ["//RetainerSet.c"] ? arg "-Wno-format"
- -- The above warning suppression flags are a temporary kludge.
- -- While working on this module you are encouraged to remove it and fix
- -- any warnings in the module. See:
- -- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
-
- , (not <$> flag GccIsClang) ?
- inputs ["//Compact.c"] ? arg "-finline-limit=2500"
-
- , inputs ["//Evac_thr.c", "//Scav_thr.c"] ?
- pure ["-DPARALLEL_GC", "-Irts/sm"]
-
- , input "//StgCRun.c" ? windowsHost ? arg "-Wno-return-local-addr"
- , input "//RetainerProfile.c" ? flag GccIsClang ?
- arg "-Wno-incompatible-pointer-types"
- , windowsHost ? arg ("-DWINVER=" ++ windowsVersion)
-
- -- libffi's ffi.h triggers various warnings
- , inputs [ "//Interpreter.c", "//Storage.c", "//Adjustor.c" ] ?
- arg "-Wno-strict-prototypes"
- , inputs ["//Interpreter.c", "//Adjustor.c", "//sm/Storage.c"] ?
- anyTargetArch ["powerpc"] ? arg "-Wno-undef"
- ]
-
- mconcat
- [ builder (Cc FindCDependencies) ? cArgs
- , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
- , builder Ghc ? arg "-Irts"
-
- , builder HsCpp ? pure
- [ "-DTOP=" ++ show top
- , "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
- , "-DFFI_LIB_DIR=" ++ show ffiLibraryDir
- , "-DFFI_LIB=" ++ show libffiName ]
-
- , builder HsCpp ?
- input "//package.conf.in" ?
- output "//package.conf.install.raw" ?
- pure [ "-DINSTALLING"
- , "-DLIB_DIR=\"" ++ destDir ++ ghclibDir ++ "\""
- , "-DINCLUDE_DIR=\"" ++ destDir ++ ghclibDir -/- "include\"" ]
-
- , builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]
-
--- See @rts/ghc.mk@.
-rtsWarnings :: Args
-rtsWarnings = mconcat
- [ pure ["-Wall", "-Werror"]
- , arg "-Wextra"
- , arg "-Wstrict-prototypes"
- , arg "-Wmissing-prototypes"
- , arg "-Wmissing-declarations"
- , arg "-Winline"
- , arg "-Waggregate-return"
- , arg "-Wpointer-arith"
- , arg "-Wmissing-noreturn"
- , arg "-Wnested-externs"
- , arg "-Wredundant-decls"
- , arg "-Wundef"
- , arg "-fno-strict-aliasing" ]
diff --git a/hadrian/src/Settings/Packages/RunGhc.hs b/hadrian/src/Settings/Packages/RunGhc.hs
deleted file mode 100644
index 03a19c8373..0000000000
--- a/hadrian/src/Settings/Packages/RunGhc.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Settings.Packages.RunGhc (runGhcPackageArgs) where
-
-import Oracles.Setting
-import Expression
-
-runGhcPackageArgs :: Args
-runGhcPackageArgs = package runGhc ? builder Ghc ? input "//Main.hs" ? do
- version <- getSetting ProjectVersion
- pure ["-cpp", "-DVERSION=" ++ show version]
diff --git a/hadrian/src/Settings/Warnings.hs b/hadrian/src/Settings/Warnings.hs
deleted file mode 100644
index abbc814291..0000000000
--- a/hadrian/src/Settings/Warnings.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where
-
-import Expression
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-
--- See @mk/warnings.mk@ for warning-related arguments in the Make build system.
-
--- | Default Haskell warning-related arguments.
-defaultGhcWarningsArgs :: Args
-defaultGhcWarningsArgs = mconcat
- [ notStage0 ? pure [ "-Werror", "-Wnoncanonical-monad-instances" ]
- , (not <$> flag GccIsClang) ? mconcat
- [ (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable"
- , arg "-optc-Wno-error=inline" ]
- , flag GccIsClang ? arg "-optc-Wno-unknown-pragmas" ]
-
--- | Package-specific warnings-related arguments, mostly suppressing various warnings.
-warningArgs :: Args
-warningArgs = builder Ghc ? do
- isIntegerSimple <- (== integerSimple) <$> getIntegerPackage
- mconcat
- [ stage0 ? mconcat
- [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ]
- , package terminfo ? pure [ "-fno-warn-unused-imports" ]
- , package transformers ? pure [ "-fno-warn-unused-matches"
- , "-fno-warn-unused-imports" ] ]
- , notStage0 ? mconcat
- [ libraryPackage ? pure [ "-Wno-deprecated-flags" ]
- , package base ? pure [ "-Wno-trustworthy-safe" ]
- , package binary ? pure [ "-Wno-deprecations" ]
- , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ]
- , package compiler ? pure [ "-Wcpp-undef" ]
- , package directory ? pure [ "-Wno-unused-imports" ]
- , package ghc ? pure [ "-Wcpp-undef" ]
- , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ]
- , package haddock ? pure [ "-Wno-unused-imports"
- , "-Wno-deprecations" ]
- , package haskeline ? pure [ "-Wno-deprecations"
- , "-Wno-unused-imports"
- , "-Wno-redundant-constraints"
- , "-Wno-simplifiable-class-constraints" ]
- , package pretty ? pure [ "-Wno-unused-imports" ]
- , package primitive ? pure [ "-Wno-unused-imports"
- , "-Wno-deprecations" ]
- , package rts ? pure [ "-Wcpp-undef" ]
- , package terminfo ? pure [ "-Wno-unused-imports" ]
- , isIntegerSimple ?
- package text ? pure [ "-Wno-unused-imports" ]
- , package transformers ? pure [ "-Wno-unused-matches"
- , "-Wno-unused-imports"
- , "-Wno-redundant-constraints"
- , "-Wno-orphans" ]
- , package win32 ? pure [ "-Wno-trustworthy-safe" ]
- , package xhtml ? pure [ "-Wno-unused-imports" ] ] ]
diff --git a/hadrian/src/Stage.hs b/hadrian/src/Stage.hs
deleted file mode 100644
index 7c9405c2b8..0000000000
--- a/hadrian/src/Stage.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module Stage (Stage (..), stageString) where
-
-import Development.Shake.Classes
-import GHC.Generics
-
--- | A stage refers to a certain compiler in GHC's build process.
---
--- * Stage 0 is built with the bootstrapping compiler, i.e. the one already
--- installed on the user's system. The compiler that is produced during
--- stage 0 is called /stage 1 compiler/.
---
--- * Stage 1 is built using the stage 1 compiler and all GHC sources. The result
--- is called /stage 2 compiler/ and it has all features of the new GHC.
---
--- * Stage 2 is built using the stage 2 compiler. The result is a compiler
--- fully "built by itself", commonly referred to as /bootstrapping/.
---
--- * Stage 3 is built as a self test. The resulting compiler should have
--- the same object code as the one built in stage 2, which is a good test
--- for the compiler. Since it serves no other purpose than that, the stage 3
--- build is usually omitted in the build process.
-data Stage = Stage0 | Stage1 | Stage2 | Stage3
- deriving (Show, Eq, Ord, Enum, Generic, Bounded)
-
-instance Binary Stage
-instance Hashable Stage
-instance NFData Stage
-
--- | Prettyprint a 'Stage'.
-stageString :: Stage -> String
-stageString stage = "stage" ++ show (fromEnum stage)
diff --git a/hadrian/src/Target.hs b/hadrian/src/Target.hs
deleted file mode 100644
index 30c8d98d14..0000000000
--- a/hadrian/src/Target.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Target (
- Target, target, context, builder, inputs, outputs, trackArgument,
- module Builder
- ) where
-
-import Data.Char
-import Data.List.Extra
-
-import qualified Hadrian.Target as H
-import Hadrian.Target hiding (Target)
-
-import Builder
-import Context
-
-type Target = H.Target Context Builder
-
--- | Some arguments do not affect build results and therefore do not need to be
--- tracked by the build system. A notable example is "-jN" that controls Make's
--- parallelism. Given a 'Target' and an argument, this function should return
--- 'True' only if the argument needs to be tracked.
-trackArgument :: Target -> String -> Bool
-trackArgument target arg = case builder target of
- (Make _) -> not $ threadArg arg
- _ -> True
- where
- threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="]
diff --git a/hadrian/src/UserSettings.hs b/hadrian/src/UserSettings.hs
deleted file mode 100644
index 1b7c3f8bdd..0000000000
--- a/hadrian/src/UserSettings.hs
+++ /dev/null
@@ -1,64 +0,0 @@
--- If you want to customise your build you should copy this file from
--- hadrian/src/UserSettings.hs to hadrian/UserSettings.hs and edit your copy.
--- 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,
- buildProgressColour, successColour, stage1Only
- ) where
-
-import Hadrian.Utilities
-import System.Console.ANSI
-
-import Flavour
-import Expression
-import {-# SOURCE #-} Settings.Default
-
--- 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.
-
--- | This is an example user-defined build flavour. Feel free to modify it and
--- use by passing @--flavour=user@ from the command line.
-userFlavour :: Flavour
-userFlavour = defaultFlavour { name = "user" } -- Modify other settings here.
-
--- | Add user-defined packages. Note, this only lets Hadrian know about the
--- existence of a new package; to actually build it you need to create a new
--- build flavour, modifying the list of packages that are built by default.
-userPackages :: [Package]
-userPackages = []
-
--- | Set to 'True' to print full command lines during the build process. Note:
--- this is a 'Predicate', hence you can enable verbose output only for certain
--- targets, e.g.: @verboseCommand = package ghcPrim@.
-verboseCommand :: Predicate
-verboseCommand = do
- verbosity <- expr getVerbosity
- return $ verbosity >= Loud
-
--- | Set colour for build progress messages (e.g. executing a build command).
-buildProgressColour :: BuildProgressColour
-buildProgressColour = BuildProgressColour (Dull, Magenta)
-
--- | Set colour for success messages (e.g. a package is built successfully).
-successColour :: SuccessColour
-successColour = SuccessColour (Dull, Green)
-
--- TODO: Set this flag from the command line.
--- | Set this flag to 'True' to disable building Stage2 GHC (i.e. the @ghc-stage2@
--- executable) and Stage2 utilities (such as @haddock@). Note that all Stage0
--- and Stage1 libraries (including 'compiler') will still be built. Enabling
--- this flag during installation leads to installing @ghc-stage1@ instead of
--- @ghc-stage2@, and @ghc-pkg@ that was build with the Stage0 compiler.
--- Also see Note [No stage2 packages when CrossCompiling or Stage1Only] in the
--- top-level @ghc.mk@.
-stage1Only :: Bool
-stage1Only = False
diff --git a/hadrian/src/Utilities.hs b/hadrian/src/Utilities.hs
deleted file mode 100644
index fc898c35b9..0000000000
--- a/hadrian/src/Utilities.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-module Utilities (
- build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith,
- needLibrary, contextDependencies, stage1Dependencies, libraryTargets,
- topsortPackages
- ) where
-
-import qualified Hadrian.Builder as H
-import Hadrian.Haskell.Cabal
-import Hadrian.Utilities
-
-import Context
-import Expression hiding (stage)
-import Oracles.PackageData
-import Settings
-import Target
-import UserSettings
-
-build :: Target -> Action ()
-build target = H.build target getArgs
-
-buildWithResources :: [(Resource, Int)] -> Target -> Action ()
-buildWithResources rs target = H.buildWithResources rs target getArgs
-
-buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
-buildWithCmdOptions opts target = H.buildWithCmdOptions opts 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
--- depend on packages built in 'Stage2' or later, therefore the stage of the
--- resulting dependencies is bounded from above at 'Stage1'. To compute package
--- dependencies we transitively scan @.cabal@ files using 'pkgDependencies'
--- defined in "Hadrian.Haskell.Cabal".
-contextDependencies :: Context -> Action [Context]
-contextDependencies Context {..} = do
- depPkgs <- go [package]
- return [ Context depStage pkg way | pkg <- depPkgs, pkg /= package ]
- where
- depStage = min stage Stage1
- go pkgs = do
- 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
-
--- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
-stage1Dependencies :: Package -> Action [Package]
-stage1Dependencies =
- fmap (map Context.package) . contextDependencies . vanillaContext Stage1
-
--- | Given a library 'Package' this action computes all of its targets. See
--- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
-libraryTargets :: Bool -> Context -> Action [FilePath]
-libraryTargets includeGhciLib context = do
- confFile <- pkgConfFile context
- libFile <- pkgLibraryFile context
- lib0File <- pkgLibraryFile0 context
- lib0 <- buildDll0 context
- ghciLib <- pkgGhciLibraryFile context
- ghciFlag <- if includeGhciLib
- then interpretInContext context $ getPkgData BuildGhciLib
- else return "NO"
- let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only)
- return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
-
--- | Coarse-grain 'need': make sure all given libraries are fully built.
-needLibrary :: [Context] -> Action ()
-needLibrary cs = need =<< concatMapM (libraryTargets True) cs
-
--- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.
--- | Topological sort of packages according to their dependencies.
-topsortPackages :: [Package] -> Action [Package]
-topsortPackages pkgs = do
- elems <- mapM (\p -> (p,) <$> stage1Dependencies p) pkgs
- return $ map fst $ topSort elems
- where
- annotateInDeg es e =
- (foldr (\e' s -> if fst e' `elem` snd e then s + 1 else s) (0 :: Int) es, e)
- topSort [] = []
- topSort es =
- let annotated = map (annotateInDeg es) es
- inDegZero = map snd $ filter ((== 0). fst) annotated
- in inDegZero ++ topSort (es \\ inDegZero)
diff --git a/hadrian/src/Way.hs b/hadrian/src/Way.hs
deleted file mode 100644
index e904d93cbc..0000000000
--- a/hadrian/src/Way.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-module Way (
- WayUnit (..), Way, wayUnit, removeWayUnit, wayFromUnits, allWays,
-
- vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging,
- threadedDebug, threadedProfiling, threadedLogging, threadedDynamic,
- threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic,
- threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic,
-
- wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf
- ) where
-
-import Data.IntSet (IntSet)
-import qualified Data.IntSet as Set
-import Data.List
-import Data.Maybe
-import Development.Shake.Classes
-import Hadrian.Utilities
-
--- Note: order of constructors is important for compatibility with the old build
--- system, e.g. we want "thr_p", not "p_thr" (see instance Show Way).
--- | A 'WayUnit' is a single way of building source code, for example with
--- profiling enabled, or dynamically linked.
-data WayUnit = Threaded
- | Debug
- | Profiling
- | Logging
- | Dynamic
- deriving (Bounded, Enum, Eq, Ord)
-
--- TODO: get rid of non-derived Show instances
-instance Show WayUnit where
- show unit = case unit of
- Threaded -> "thr"
- Debug -> "debug"
- Profiling -> "p"
- Logging -> "l"
- Dynamic -> "dyn"
-
-instance Read WayUnit where
- readsPrec _ s = [(unit, "") | unit <- [minBound ..], show unit == s]
-
--- | Collection of 'WayUnit's that stands for the different ways source code
--- is to be built.
-newtype Way = Way IntSet
-
-instance Binary Way where
- put = put . show
- get = fmap read get
-
-instance Hashable Way where
- hashWithSalt salt = hashWithSalt salt . show
-
-instance NFData Way where
- rnf (Way s) = s `seq` ()
-
--- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'.
-wayFromUnits :: [WayUnit] -> Way
-wayFromUnits = Way . Set.fromList . map fromEnum
-
--- | Split a 'Way' into its 'WayUnit' building blocks.
--- Inverse of 'wayFromUnits'.
-wayToUnits :: Way -> [WayUnit]
-wayToUnits (Way set) = map toEnum . Set.elems $ set
-
--- | Check whether a 'Way' contains a certain 'WayUnit'.
-wayUnit :: WayUnit -> Way -> Bool
-wayUnit unit (Way set) = fromEnum unit `Set.member` set
-
--- | Remove a 'WayUnit' from 'Way'.
-removeWayUnit :: WayUnit -> Way -> Way
-removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set
-
-instance Show Way where
- show way = if null tag then "v" else tag
- where
- tag = intercalate "_" . map show . wayToUnits $ way
-
-instance Read Way where
- readsPrec _ s = if s == "v" then [(vanilla, "")] else result
- where
- uniqueReads token = case reads token of
- [(unit, "")] -> Just unit
- _ -> Nothing
- units = map uniqueReads . words . replaceEq '_' ' ' $ s
- result = if Nothing `elem` units
- then []
- else [(wayFromUnits . map fromJust $ units, "")]
-
-instance Eq Way where
- Way a == Way b = a == b
-
-instance Ord Way where
- compare (Way a) (Way b) = compare a b
-
--- | Build default _vanilla_ way.
-vanilla :: Way
-vanilla = wayFromUnits []
-
--- | Build with profiling.
-profiling :: Way
-profiling = wayFromUnits [Profiling]
-
--- | Build with dynamic linking.
-dynamic :: Way
-dynamic = wayFromUnits [Dynamic]
-
--- | Build with profiling and dynamic linking.
-profilingDynamic :: Way
-profilingDynamic = wayFromUnits [Profiling, Dynamic]
-
--- RTS only ways below. See compiler/main/DynFlags.hs.
--- | Build RTS with event logging.
-logging :: Way
-logging = wayFromUnits [Logging]
-
--- | Build multithreaded RTS.
-threaded :: Way
-threaded = wayFromUnits [Threaded]
-
--- | Build RTS with debug information.
-debug :: Way
-debug = wayFromUnits [Debug]
-
--- | Various combinations of RTS only ways.
-threadedDebug, threadedProfiling, threadedLogging, threadedDynamic,
- threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic,
- threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic :: Way
-threadedDebug = wayFromUnits [Threaded, Debug]
-threadedProfiling = wayFromUnits [Threaded, Profiling]
-threadedLogging = wayFromUnits [Threaded, Logging]
-threadedDynamic = wayFromUnits [Threaded, Dynamic]
-threadedDebugProfiling = wayFromUnits [Threaded, Debug, Profiling]
-threadedDebugDynamic = wayFromUnits [Threaded, Debug, Dynamic]
-threadedProfilingDynamic = wayFromUnits [Threaded, Profiling, Dynamic]
-threadedLoggingDynamic = wayFromUnits [Threaded, Logging, Dynamic]
-debugProfiling = wayFromUnits [Debug, Profiling]
-debugDynamic = wayFromUnits [Debug, Dynamic]
-loggingDynamic = wayFromUnits [Logging, Dynamic]
-
--- | All ways supported by the build system.
-allWays :: [Way]
-allWays =
- [ vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging
- , threadedDebug, threadedProfiling, threadedLogging, threadedDynamic
- , threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic
- , threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic ]
-
-wayPrefix :: Way -> String
-wayPrefix way | way == vanilla = ""
- | otherwise = show way ++ "_"
-
-waySuffix :: Way -> String
-waySuffix way | way == vanilla = ""
- | otherwise = "_" ++ show way
-
-osuf, ssuf, hisuf, hcsuf, obootsuf, hibootsuf :: Way -> String
-osuf = (++ "o" ) . wayPrefix
-ssuf = (++ "s" ) . wayPrefix
-hisuf = (++ "hi" ) . wayPrefix
-hcsuf = (++ "hc" ) . wayPrefix
-obootsuf = (++ "o-boot" ) . wayPrefix
-hibootsuf = (++ "hi-boot") . wayPrefix