Commit 79ad8ee4 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Finish Args datatype, propagate changes to related modules.

parent cb2003ce
......@@ -12,10 +12,11 @@ module Expression.Base (
project,
arg, args, argsOrdered, argBuildPath, argBuildDir,
argInput, argOutput,
argConfig, argConfigStaged, argBuilderPath, argStagedBuilderPath,
argConfig, argStagedConfig, argBuilderPath, argStagedBuilderPath,
argWithBuilder, argWithStagedBuilder,
argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
argIncludeDirs, argDepIncludeDirs,
argConcat, argConcatPath, argPairs, argPrefix,
argConcat, argConcatPath, argConcatSpace, argPairs, argPrefix,
argBootPkgConstraints,
setPackage, setBuilder, setBuilderFamily, setStage, setWay,
setFile, setConfig
......@@ -37,16 +38,14 @@ data Args
| Input -- evaluates to input file(s): "src.c"
| Output -- evaluates to output file(s): "src.o"
| Config String -- evaluates to the value of a given config key
| ConfigStaged String -- as above, but stage is appended to the key
| BuilderPath Builder -- evaluates to the path to a given builder
| PackageData String -- looks up value a given key in package-data.mk
| BootPkgConstraints -- evaluates to boot package constraints
| Pair Combine Args Args -- combine two Args using a given append method
| Fold Combine Settings -- fold settings using a given combine method
-- Assume original settings structure: (a `op1` b `op2` c ...)
data Combine = Concat -- Concatenate all: a ++ b ++ c ...
| ConcatPath -- </>-concatenate all: a </> b </> c ...
data Combine = Concat -- Concatenate: a ++ b
| ConcatPath -- </>-concatenate: a </> b
| ConcatSpace -- concatenate with a space: a ++ " " ++ b
type Ways = BuildExpression Way
type Settings = BuildExpression Args
......@@ -80,8 +79,12 @@ argOutput = return Output
argConfig :: String -> Settings
argConfig = return . Config
argConfigStaged :: String -> Settings
argConfigStaged = return . ConfigStaged
argStagedConfig :: String -> Settings
argStagedConfig key =
msum $ map (\s -> stage s ? argConfig (stagedKey s)) [Stage0 ..]
where
stagedKey :: Stage -> String
stagedKey stage = key ++ "-stage" ++ show stage
argBuilderPath :: Builder -> Settings
argBuilderPath = return . BuilderPath
......@@ -91,6 +94,25 @@ argStagedBuilderPath :: (Stage -> Builder) -> Settings
argStagedBuilderPath f =
msum $ map (\s -> stage s ? argBuilderPath (f s)) [Stage0 ..]
argWithBuilder :: Builder -> Settings
argWithBuilder builder =
let key = case builder of
Ar -> "--with-ar="
Ld -> "--with-ld="
Gcc _ -> "--with-gcc="
Ghc _ -> "--with-ghc="
Alex -> "--with-alex="
Happy -> "--with-happy="
GhcPkg _ -> "--with-ghc-pkg="
HsColour -> "--with-hscolour="
in
argPrefix key (argBuilderPath builder)
argWithStagedBuilder :: (Stage -> Builder) -> Settings
argWithStagedBuilder f =
msum $ map (\s -> stage s ? argWithBuilder (f s)) [Stage0 ..]
-- Accessing key value pairs from package-data.mk files
argPackageKey :: Settings
argPackageKey = return $ PackageData "PACKAGE_KEY"
......@@ -113,25 +135,29 @@ argDepIncludeDirs = return $ PackageData "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
argBootPkgConstraints :: Settings
argBootPkgConstraints = return BootPkgConstraints
-- A concatenation of arguments: arg1 ++ arg2 ++ ...
-- Concatenate arguments: arg1 ++ arg2 ++ ...
argConcat :: Settings -> Settings
argConcat = return . Fold Concat
-- A </>-concatenation of arguments: arg1 </> arg2 </> ...
-- </>-concatenate arguments: arg1 </> arg2 </> ...
argConcatPath :: Settings -> Settings
argConcatPath = return . Fold ConcatPath
-- Concatene arguments (space separated): arg1 ++ " " ++ arg2 ++ ...
argConcatSpace :: Settings -> Settings
argConcatSpace = return . Fold ConcatSpace
-- An ordered list of pairs of arguments: prefix |> arg1, prefix |> arg2, ...
argPairs :: String -> Settings -> Settings
argPairs prefix settings = settings >>= (arg prefix |>) . return
-- An ordered list of prefixed arguments: prefix ++ arg1, prefix ++ arg2, ...
argPrefix :: String -> Settings -> Settings
argPrefix prefix = fmap (Pair Concat $ Plain prefix)
argPrefix prefix = fmap (Fold Concat . (arg prefix |>) . return)
-- An ordered list of prefixed arguments: prefix </> arg1, prefix </> arg2, ...
argPaths :: String -> Settings -> Settings
argPaths prefix = fmap (Pair ConcatPath $ Plain prefix)
argPaths prefix = fmap (Fold ConcatPath . (arg prefix |>) . return)
-- Partially evaluate Settings using a truth-teller (compute a 'projection')
project :: (BuildVariable -> Maybe Bool) -> Settings -> Settings
......
......@@ -5,7 +5,7 @@ module Expression.Build (
BuildPredicate (..),
BuildExpression (..),
evaluate, tellTruth,
linearise, msum, mproduct, fromList, fromOrderedList,
linearise, (|>), msum, mproduct, fromList, fromOrderedList,
packages, package, matchPackage,
builders, builder, matchBuilder, matchBuilderFamily,
stages, stage, notStage, matchStage,
......
......@@ -3,6 +3,7 @@ import Config
import Oracles
import Package
import Targets
import Settings
main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
oracleRules
......
......@@ -11,19 +11,21 @@ import Ways
import Oracles.Builder
import Expression.Base
whenPackageKey :: BuildPredicate
whenPackageKey = supportsPackageKey && notStage Stage0
validating :: BuildPredicate
validating = false
packageSettings :: Settings
packageSettings = mconcat
packageSettings = msum
[ args ["-hide-all-packages", "-no-user-package-db", "-include-pkg-deps"]
, stage Stage0 ? args ["-package-db libraries/bootstrapping.conf"]
, whenPackageKey ??
( argPackageKey "-this-package-key" <> argPackageDepKeys "-package-key"
, argPackageKey "-package-name" <> argPackageDeps "-package" )]
, stage Stage0 ? arg "-package-db libraries/bootstrapping.conf"
, supportsPackageKey && notStage Stage0 ??
( argPairs "-this-package-key" argPackageKey <|>
argPairs "-package-key" argPackageDepKeys
, argPairs "-package-name" argPackageKey <|>
argPairs "-package" argPackageDeps )]
librarySettings :: Ways -> Settings
librarySettings ways = mconcat
librarySettings ways = msum
[ whenExists vanilla ways ?? ( arg "--enable-library-vanilla"
, arg "--disable-library-vanilla" )
, (ghcWithInterpreter
......@@ -35,37 +37,34 @@ librarySettings ways = mconcat
, whenExists dynamic ways ?? ( arg "--enable-shared"
, arg "--disable-shared" )]
validating :: BuildPredicate
validating = false
ccSettings :: Settings
ccSettings = mconcat
ccSettings = msum
[ package integerLibrary ? arg "-Ilibraries/integer-gmp2/gmp"
, builder GhcCabal ? argConfigStaged "conf-cc-args"
, validating ? mconcat
, builder GhcCabal ? argStagedConfig "conf-cc-args"
, validating ? msum
[ not (builder GhcCabal) ? arg "-Werror"
, arg "-Wall"
, gccIsClang ??
( arg "-Wno-unknown-pragmas" <>
( arg "-Wno-unknown-pragmas" <|>
not gccLt46 && windowsHost ? arg "-Werror=unused-but-set-variable"
, not gccLt46 ? arg "-Wno-error=inline" )
]
]
, not gccLt46 ? arg "-Wno-error=inline" )]]
ldSettings :: Settings
ldSettings = builder GhcCabal ? argConfigStaged "conf-gcc-linker-args"
ldSettings = builder GhcCabal ? argStagedConfig "conf-gcc-linker-args"
cppSettings :: Settings
cppSettings = builder GhcCabal ? argConfigStaged "conf-cpp-args"
cppSettings = builder GhcCabal ? argStagedConfig "conf-cpp-args"
configureSettings :: Settings
configureSettings =
let conf key = argComplex $ "--configure-option=" ++ key ++ "="
let conf key = argPrefix ("--configure-option=" ++ key ++ "=")
. argConcatSpace
in
mconcat [ conf "CFLAGS" ccSettings
msum [ conf "CFLAGS" ccSettings
, conf "LDFLAGS" ldSettings
, conf "CPPFLAGS" cppSettings
, argComplex "--gcc-options=" (ccSettings <> ldSettings)
, argPrefix "--gcc-options=" $
argConcatSpace (ccSettings <|> ldSettings)
, conf "--with-iconv-includes" (argConfig "iconv-include-dirs")
, conf "--with-iconv-libraries" (argConfig "iconv-lib-dirs")
, conf "--with-gmp-includes" (argConfig "gmp-include-dirs")
......@@ -83,7 +82,7 @@ dllSettings = arg ""
-- customConfArgs
customConfigureSettings :: Settings
customConfigureSettings = mconcat
customConfigureSettings = msum
[ package base ? arg ("--flags=" ++ integerLibraryName)
, package ghcPrim ? arg "--flag=include-ghc-prim"
, package integerLibrary && windowsHost ?
......@@ -94,33 +93,40 @@ customConfigureSettings = mconcat
bootPackageDbSettings :: Settings
bootPackageDbSettings =
stage Stage0 ?
argPath "--package-db="
(argConfig "ghc-source-path" <> arg "libraries/bootstrapping.conf")
argPrefix "--package-db="
(argConcatPath $
argConfig "ghc-source-path" |>
arg "libraries" |>
arg "bootstrapping.conf" )
cabalSettings :: Settings
cabalSettings =
argsOrdered ["configure", argBuildPath, argBuildDist, dllSettings]
`fence`
mconcat
[ argStagedBuilderPath Ghc -- TODO: used to be limited to max stage1 GHC
, argStagedBuilderPath GhcPkg
mproduct
[ argBuilderPath GhcCabal
, arg "configure"
, argBuildPath
, argBuildDir
, dllSettings ]
|>
msum
[ argWithStagedBuilder Ghc -- TODO: used to be limited to max stage1 GHC
, argWithStagedBuilder GhcPkg
, customConfigureSettings
, bootPackageDbSettings
, stage Stage0 ? bootPackageDbSettings
, librarySettings targetWays
, configNonEmpty "hscolour" ? argBuilderPath HsColour -- TODO: more reuse
, configNonEmpty "hscolour" ? argWithBuilder HsColour -- TODO: more reuse
, configureSettings
, stage Stage0 ? argBootPkgConstraints
, argStagedBuilderPath Gcc
, notStage Stage0 ? argBuilderPath Ld
, argBuilderPath Ar
, argBuilderPath Alex
, argBuilderPath Happy ] -- TODO: reorder with's
, argWithStagedBuilder Gcc
, notStage Stage0 ? argWithBuilder Ld
, argWithBuilder Ar
, argWithBuilder Alex
, argWithBuilder Happy ] -- TODO: reorder with's
ghcPkgSettings :: Settings
ghcPkgSettings =
arg "update"
`fence` mconcat
[ arg "--force"
, argPath "" $
mconcat [argBuildPath, argBuildDist, arg "inplace-pkg-config"]
, bootPackageDbSettings ]
arg "update" |> msum
[ arg "--force"
, argConcatPath $
msum [argBuildPath, argBuildDir, arg "inplace-pkg-config"]
, bootPackageDbSettings ]
{-# LANGUAGE NoImplicitPrelude #-}
module Targets (
buildHaddock,
targetWays, targetPackages, targetPackagesInStage,
targetWays, targetPackages,
IntegerLibraryImpl (..), integerLibraryImpl, integerLibraryName,
array, base, binPackageDb, binary, bytestring, cabal, containers, deepseq,
directory, filepath, ghcPrim, haskeline, hoopl, hpc, integerLibrary,
......@@ -9,7 +9,7 @@ module Targets (
transformers, unix, win32, xhtml
) where
import Ways
import qualified Ways
import Base
import Package
import Expression.Base
......@@ -19,14 +19,14 @@ buildHaddock = true
-- These are the packages we build
targetPackages :: Packages
targetPackages =
targetPackages = msum
[ stage Stage0 ? packagesStage0
, stage Stage1 ? packagesStage1 ]
packagesStage0 :: Packages
packagesStage0 = mconcat
packagesStage0 = msum
[ fromList [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
, windowsHost && not (targetOs "ios") ? terminfo ]
, windowsHost && not (targetOs "ios") ? return terminfo ]
packagesStage1 :: Packages
packagesStage1 = msum
......@@ -34,16 +34,16 @@ packagesStage1 = msum
, fromList [ array, base, bytestring, containers, deepseq, directory
, filepath, ghcPrim, haskeline, integerLibrary, parallel
, pretty, primitive, process, stm, templateHaskell, time ]
, not windowsHost ? unix
, windowsHost ? win32
, buildHaddock ? xhtml ]
, not windowsHost ? return unix
, windowsHost ? return win32
, buildHaddock ? return xhtml ]
-- Packages will be build these ways
targetWays :: Ways
targetWays = msum
[ return vanilla -- always build vanilla
, notStage Stage0 ? return profiling
, platformSupportsSharedLibs ? return dynamic ]
[ return Ways.vanilla -- always build vanilla
, notStage Stage0 ? return Ways.profiling
, platformSupportsSharedLibs ? return Ways.dynamic ]
-- Build results will be placed into a target directory with the following
-- typical structure:
......
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