Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
3be52c5a
Commit
3be52c5a
authored
Jul 13, 2016
by
Andrey Mokhov
Browse files
Refactor build flavours
See
#268
.
parent
fa4ca65a
Changes
43
Hide whitespace changes
Inline
Side-by-side
hadrian.cabal
View file @
3be52c5a
...
...
@@ -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
...
...
src/CmdLineFlag.hs
View file @
3be52c5a
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
...
...
src/Flavour.hs
0 → 100644
View file @
3be52c5a
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.
src/Oracles/ArgsHash.hs
View file @
3be52c5a
...
...
@@ -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
)
...
...
src/Oracles/Dependencies.hs
View file @
3be52c5a
...
...
@@ -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
)
...
...
src/Oracles/WindowsPath.hs
View file @
3be52c5a
{-# 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"
...
...
src/Rules.hs
View file @
3be52c5a
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:
d
o we want libffiLibrary to be a top-level target?
-- TODO:
D
o 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
for
M
_
allStages
$
\
stage
->
for
M
_
(
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
for
M
_
contexts
$
mconcat
[
Rules
.
Compile
.
compilePackage
readPackageDb
,
Rules
.
Library
.
buildPackageLibrary
]
for_
vanillaContexts
$
mconcat
for
M
_
vanillaContexts
$
mconcat
[
Rules
.
Data
.
buildPackageData
,
Rules
.
Dependencies
.
buildPackageDependencies
readPackageDb
,
Rules
.
Documentation
.
buildPackageDocumentation
...
...
src/Rules/Actions.hs
View file @
3be52c5a
...
...
@@ -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.
...
...
src/Rules/Cabal.hs
View file @
3be52c5a
...
...
@@ -10,6 +10,7 @@ import Base
import
Expression
import
GHC
import
Settings
import
Settings.Paths
cabalRules
::
Rules
()
cabalRules
=
do
...
...
src/Rules/Clean.hs
View file @
3be52c5a
...
...
@@ -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
...
...
src/Rules/Compile.hs
View file @
3be52c5a
...
...
@@ -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
()
...
...
src/Rules/Data.hs
View file @
3be52c5a
...
...
@@ -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
()
...
...
src/Rules/Dependencies.hs
View file @
3be52c5a
...
...
@@ -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
{
..
}
=
...
...
src/Rules/Documentation.hs
View file @
3be52c5a
...
...
@@ -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
...
...
src/Rules/Generate.hs
View file @
3be52c5a
...
...
@@ -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"
...
...
src/Rules/Generators/ConfigHs.hs
View file @
3be52c5a
...
...
@@ -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
]
src/Rules/Library.hs
View file @
3be52c5a
...
...
@@ -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"
...
...
src/Rules/Program.hs
View file @
3be52c5a
...
...
@@ -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.
...
...
src/Rules/Register.hs
View file @
3be52c5a
...
...
@@ -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.
...
...
src/Rules/Test.hs
View file @
3be52c5a
...
...
@@ -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
...
...
Prev
1
2
3
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment