Commit 3be52c5a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactor build flavours

See #268.
parent fa4ca65a
......@@ -24,6 +24,7 @@ executable hadrian
, Context
, Environment
, Expression
, Flavour
, GHC
, Oracles.ArgsHash
, Oracles.Config
......@@ -68,7 +69,6 @@ executable hadrian
, Rules.Wrappers.Ghc
, Rules.Wrappers.GhcPkg
, Settings
, Settings.Args
, Settings.Builders.Alex
, Settings.Builders.Ar
, Settings.Builders.Common
......@@ -90,7 +90,6 @@ executable hadrian
, Settings.Default
, Settings.Flavours.Quick
, Settings.Flavours.Quickest
, Settings.Packages
, Settings.Packages.Base
, Settings.Packages.Compiler
, Settings.Packages.Directory
......@@ -106,7 +105,6 @@ executable hadrian
, Settings.Packages.Touchy
, Settings.Packages.Unlit
, Settings.Paths
, Settings.Ways
, Stage
, Target
, UserSettings
......
module CmdLineFlag (
putCmdLineFlags, cmdFlags, cmdBuildHaddock, cmdFlavour, Flavour (..),
cmdProgressColour, ProgressColour (..), cmdProgressInfo, ProgressInfo (..),
cmdSkipConfigure, cmdSplitObjects
putCmdLineFlags, cmdFlags, cmdBuildHaddock, cmdFlavour, cmdProgressColour,
ProgressColour (..), cmdProgressInfo, ProgressInfo (..), cmdSkipConfigure,
cmdSplitObjects
) where
import Data.IORef
......@@ -14,14 +14,13 @@ import System.IO.Unsafe
-- build rules to be rurun.
data Untracked = Untracked
{ buildHaddock :: Bool
, flavour :: Flavour
, flavour :: Maybe String
, progressColour :: ProgressColour
, progressInfo :: ProgressInfo
, skipConfigure :: Bool
, splitObjects :: Bool }
deriving (Eq, Show)
data Flavour = Default | Quick | Quickest deriving (Eq, Show)
data ProgressColour = Never | Auto | Always deriving (Eq, Show)
data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show)
......@@ -29,7 +28,7 @@ data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show)
defaultUntracked :: Untracked
defaultUntracked = Untracked
{ buildHaddock = False
, flavour = Default
, flavour = Nothing
, progressColour = Auto
, progressInfo = Normal
, skipConfigure = False
......@@ -39,16 +38,7 @@ readBuildHaddock :: Either String (Untracked -> Untracked)
readBuildHaddock = Right $ \flags -> flags { buildHaddock = True }
readFlavour :: Maybe String -> Either String (Untracked -> Untracked)
readFlavour ms =
maybe (Left "Cannot parse flavour") (Right . set) (go =<< lower <$> ms)
where
go :: String -> Maybe Flavour
go "default" = Just Default
go "quick" = Just Quick
go "quickest" = Just Quickest
go _ = Nothing
set :: Flavour -> Untracked -> Untracked
set flag flags = flags { flavour = flag }
readFlavour ms = Right $ \flags -> flags { flavour = ms }
readProgressColour :: Maybe String -> Either String (Untracked -> Untracked)
readProgressColour ms =
......@@ -112,7 +102,7 @@ getCmdLineFlags = unsafePerformIO $ readIORef cmdLineFlags
cmdBuildHaddock :: Bool
cmdBuildHaddock = buildHaddock getCmdLineFlags
cmdFlavour :: Flavour
cmdFlavour :: Maybe String
cmdFlavour = flavour getCmdLineFlags
cmdProgressColour :: ProgressColour
......
module Flavour (Flavour (..)) where
import Expression
-- TODO: Merge {libraryWays, rtsWays}, and {dynamicGhcPrograms, ghcProfiled...}.
-- | 'Flavour' is a collection of build settings that fully define a GHC build.
data Flavour = Flavour
{ name :: String -- ^ Flavour name, to set from command line.
, args :: Args -- ^ Use these command line arguments.
, packages :: Packages -- ^ Build these packages.
, libraryWays :: Ways -- ^ Build libraries these ways.
, rtsWays :: Ways -- ^ Build RTS these ways.
, splitObjects :: Predicate -- ^ Build split objects.
, buildHaddock :: Predicate -- ^ Build Haddock and documentation.
, dynamicGhcPrograms :: Bool -- ^ Build dynamic GHC programs.
, ghciWithDebugger :: Bool -- ^ Enable GHCi debugger.
, ghcProfiled :: Bool -- ^ Build profiled GHC.
, ghcDebugged :: Bool } -- ^ Build GHC with debug information.
......@@ -4,8 +4,8 @@ module Oracles.ArgsHash (checkArgsHash, argsHashOracle) where
import Base
import Expression
import Settings
import Settings.Args
import Target
import UserSettings
newtype ArgsHashKey = ArgsHashKey Target
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
......
......@@ -11,6 +11,7 @@ import Expression
import Oracles.PackageData
import Settings
import Settings.Builders.GhcCabal
import Settings.Paths
newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
......
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Oracles.WindowsPath (
fixAbsolutePathOnWindows, topDirectory, windowsPathOracle
fixAbsolutePathOnWindows, topDirectory, getTopDirectory, windowsPathOracle
) where
-- TODO: Rename to Oracles.Path.
import Control.Monad.Trans.Reader
import Data.Char
import Base
......@@ -15,6 +18,9 @@ newtype WindowsPath = WindowsPath FilePath
topDirectory :: Action FilePath
topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
getTopDirectory :: ReaderT a Action FilePath
getTopDirectory = lift topDirectory
-- | Fix an absolute path on Windows:
-- * "/c/" => "C:/"
-- * "/usr/bin/tar.exe" => "C:/msys/usr/bin/tar.exe"
......
module Rules (topLevelTargets, buildRules) where
import Data.Foldable
import Base
import Context
import Expression
import Flavour
import GHC
import qualified Rules.Compile
import qualified Rules.Data
......@@ -20,25 +19,26 @@ import qualified Rules.Perl
import qualified Rules.Program
import qualified Rules.Register
import Settings
import Settings.Paths
allStages :: [Stage]
allStages = [minBound ..]
-- | 'need' all top-level build targets
-- | This rule 'need' all top-level build targets.
topLevelTargets :: Rules ()
topLevelTargets = do
want $ Rules.Generate.installTargets
-- TODO: do we want libffiLibrary to be a top-level target?
-- TODO: Do we want libffiLibrary to be a top-level target?
action $ do -- TODO: Add support for all rtsWays
rtsLib <- pkgLibraryFile $ rtsContext { way = vanilla }
rtsThrLib <- pkgLibraryFile $ rtsContext { way = threaded }
need [ rtsLib, rtsThrLib ]
for_ allStages $ \stage ->
for_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
forM_ allStages $ \stage ->
forM_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
let context = vanillaContext stage pkg
activePackages <- interpretInContext context getPackages
when (pkg `elem` activePackages) $
......@@ -46,7 +46,7 @@ topLevelTargets = do
then do -- build a library
ways <- interpretInContext context getLibraryWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways
docs <- interpretInContext context buildHaddock
docs <- interpretInContext context $ buildHaddock flavour
need $ libs ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
else do -- otherwise build a program
need [ fromJust $ programPath context ] -- TODO: drop fromJust
......@@ -65,11 +65,11 @@ packageRules = do
let contexts = liftM3 Context allStages knownPackages allWays
vanillaContexts = liftM2 vanillaContext allStages knownPackages
for_ contexts $ mconcat
forM_ contexts $ mconcat
[ Rules.Compile.compilePackage readPackageDb
, Rules.Library.buildPackageLibrary ]
for_ vanillaContexts $ mconcat
forM_ vanillaContexts $ mconcat
[ Rules.Data.buildPackageData
, Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation
......
......@@ -17,9 +17,9 @@ import Oracles.ArgsHash
import Oracles.DirectoryContent
import Oracles.WindowsPath
import Settings
import Settings.Args
import Settings.Builders.Ar
import Target
import UserSettings
-- | Build a 'Target' with the right 'Builder' and command line arguments.
-- Force a rebuild if the argument list has changed since the last build.
......
......@@ -10,6 +10,7 @@ import Base
import Expression
import GHC
import Settings
import Settings.Paths
cabalRules :: Rules ()
cabalRules = do
......
......@@ -5,7 +5,7 @@ import Context
import Package
import Rules.Actions
import Rules.Generate
import Settings.Packages
import Settings
import Settings.Paths
import Stage
import UserSettings
......
......@@ -5,7 +5,7 @@ import Context
import Expression
import Oracles.Dependencies
import Rules.Actions
import Settings
import Settings.Paths
import Target
compilePackage :: [(Resource, Int)] -> Context -> Rules ()
......
......@@ -9,9 +9,10 @@ import Oracles.Dependencies
import Rules.Actions
import Rules.Generate
import Rules.Libffi
import Settings
import Settings.Builders.Common
import Settings.Paths
import Target
import UserSettings
-- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
buildPackageData :: Context -> Rules ()
......
......@@ -8,8 +8,9 @@ import Expression
import Oracles.ModuleFiles
import Oracles.PackageData
import Rules.Actions
import Settings
import Settings.Paths
import Target
import UserSettings
buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
buildPackageDependencies rs context@Context {..} =
......
......@@ -3,11 +3,13 @@ module Rules.Documentation (buildPackageDocumentation) where
import Base
import Context
import Expression
import Flavour
import GHC
import Oracles.ModuleFiles
import Oracles.PackageData
import Rules.Actions
import Settings
import Settings.Paths
import Target
haddockHtmlLib :: FilePath
......@@ -38,7 +40,7 @@ buildPackageDocumentation context@Context {..} =
-- Build Haddock documentation
-- TODO: pass the correct way from Rules via Context
let haddockWay = if dynamicGhcPrograms then dynamic else vanilla
let haddockWay = if dynamicGhcPrograms flavour then dynamic else vanilla
build $ Target (context {way = haddockWay}) Haddock srcs [file]
when (package == haddock) $ haddockHtmlLib %> \_ -> do
......
......@@ -19,8 +19,9 @@ import Rules.Generators.GhcSplit
import Rules.Generators.GhcVersionH
import Rules.Generators.VersionHs
import Rules.Libffi
import Settings
import Settings.Paths
import Target
import UserSettings
installTargets :: [FilePath]
installTargets = [ "inplace/lib/ghc-usage.txt"
......
......@@ -2,11 +2,13 @@ module Rules.Generators.ConfigHs (generateConfigHs) where
import Base
import Expression
import Flavour
import GHC
import Oracles.Config.Flag
import Oracles.Config.Setting
import Settings
import Rules.Generators.Common
import Settings
import UserSettings
generateConfigHs :: Expr String
generateConfigHs = do
......@@ -96,6 +98,6 @@ generateConfigHs = do
, "cGhcThreaded :: Bool"
, "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
, "cGhcDebugged :: Bool"
, "cGhcDebugged = " ++ show ghcDebugged
, "cGhcDebugged = " ++ show (ghcDebugged flavour)
, "cGhcRtsWithLibdw :: Bool"
, "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
......@@ -8,11 +8,14 @@ import qualified System.Directory as IO
import Base
import Context
import Expression
import Flavour
import Oracles.PackageData
import Rules.Actions
import Rules.Gmp
import Settings
import Settings.Paths
import Target
import UserSettings
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
......@@ -34,7 +37,7 @@ buildPackageLibrary context@Context {..} = do
-- explicitly as this would needlessly bloat the Shake database).
need $ cObjs ++ hObjs
split <- interpretInContext context splitObjects
split <- interpretInContext context $ splitObjects flavour
splitObjs <- if not split then return hObjs else -- TODO: make clearer!
concatForM hSrcs $ \src -> do
let splitPath = path -/- src ++ "_" ++ osuf way ++ "_split"
......
......@@ -14,7 +14,9 @@ import Rules.Library
import Rules.Wrappers.Ghc
import Rules.Wrappers.GhcPkg
import Settings
import Settings.Paths
import Target
import UserSettings
-- TODO: Move to buildRootPath, see #113.
-- | Directory for wrapped binaries.
......
......@@ -6,8 +6,8 @@ import Expression
import GHC
import Rules.Actions
import Rules.Libffi
import Settings
import Settings.Packages.Rts
import Settings.Paths
import Target
-- | Build package-data.mk by processing the .cabal file with ghc-cabal utility.
......
......@@ -3,14 +3,14 @@ module Rules.Test (testRules) where
import Base
import Builder
import Expression
import Flavour
import GHC
import Oracles.Config.Flag
import Oracles.Config.Setting
import Oracles.WindowsPath
import Rules.Actions
import Settings.Packages
import Settings
import Target
import UserSettings
-- TODO: clean up after testing
testRules :: Rules ()
......@@ -43,7 +43,7 @@ testRules = do
, "-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=" ++ yesNo ghcDebugged
, "-e", "ghc_debugged=" ++ yesNo (ghcDebugged flavour)
, "-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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment