Commit 031179a7 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Finish buildPackageData with the Reader approach.

parent fdb6117f
......@@ -7,7 +7,6 @@ module Expression.Settings (
arg, args,
argConfig, argStagedConfig, argConfigList, argStagedConfigList,
-- argBuilderPath, argStagedBuilderPath,
-- argWithBuilder, argWithStagedBuilder,
-- argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
-- argIncludeDirs, argDepIncludeDirs,
-- argConcat, argConcatPath, argConcatSpace,
......@@ -19,31 +18,31 @@ import Base hiding (Args, arg, args)
import Oracles hiding (not)
import Expression
type Settings m = Expression m [String]
type Settings = Expression [String]
-- A single argument
arg :: Monad m => String -> Settings m
arg :: String -> Settings
arg = return . return
-- A list of arguments
args :: Monad m => [String] -> Settings m
args :: [String] -> Settings
args = return
argConfig :: String -> Settings Action
argConfig :: String -> Settings
argConfig = lift . fmap return . askConfig
argConfigList :: String -> Settings Action
argConfigList :: String -> Settings
argConfigList = lift . fmap words . askConfig
stagedKey :: Stage -> String -> String
stagedKey stage key = key ++ "-stage" ++ show stage
argStagedConfig :: String -> Settings Action
argStagedConfig :: String -> Settings
argStagedConfig key = do
stage <- asks getStage
argConfig (stagedKey stage key)
argStagedConfigList :: String -> Settings Action
argStagedConfigList :: String -> Settings
argStagedConfigList key = do
stage <- asks getStage
argConfigList (stagedKey stage key)
......
......@@ -5,37 +5,30 @@ module Rules (
) where
import Base hiding (arg, args, Args)
import Util
import Control.Monad
import Targets
-- import Settings
import Settings
import Package
import Expression
import Rules.Package
-- generateTargets needs package-data.mk files of all target packages
-- TODO: make interpret total
generateTargets :: Rules ()
generateTargets = action $ do
forM_ [Stage0 ..] $ \stage -> do
pkgs <- evaluate $ project stage targetPackages
case linearise pkgs of
Nothing -> redError "Cannot determine target packages."
Just pkgList -> do
forM_ pkgList $ \pkg -> do
dirs <- evaluate $ project (stage, pkg) targetDirectories
case linearise dirs of
Just [TargetDir dir] -> do
need [pkgPath pkg </> dir </> "package-data.mk"]
_ -> redError "Cannot determine target directory."
generateTargets = action $
forM_ [Stage0 ..] $ \stage ->
forM_ targetPackages $ \pkg -> do
let env = defaultEnvironment { getStage = stage, getPackage = pkg }
dir = targetDirectory stage pkg
required <- interpret env (packagePredicate pkg)
when required $ need [pkgPath pkg </> dir </> "package-data.mk"]
-- TODO: simplify
-- TODO: make interpret total
-- TODO: add Stage2 (compiler only?)
packageRules :: Rules ()
packageRules =
forM_ [Stage0 ..] $ \stage -> do
forM_ (support $ simplify $ project stage targetPackages) $ \pkg -> do
let dirs = project (stage, pkg) targetDirectories
case linearise dirs of
Just [dir] -> do
let ways = project (stage, pkg) targetWays
stgs = project (stage, pkg, dir) buildSettings
buildDir = pkgPath pkg </> fromTargetDir dir
buildPackage stage pkg buildDir ways stgs
_ -> action $ redError "Cannot determine target directory."
forM_ [Stage0, Stage1] $ \stage -> do
forM_ targetPackages $ \pkg -> do
let dir = pkgPath pkg </> targetDirectory stage pkg
buildPackage stage pkg dir targetWays buildSettings
{-# LANGUAGE NoImplicitPrelude #-}
module Rules.Data (
cabalSettings, ghcPkgSettings, buildPackageData
) where
......@@ -6,84 +5,116 @@ module Rules.Data (
import qualified Ways
import Base hiding (arg, args, Args)
import Package
import Expression
import Expression hiding (when, liftIO)
import Oracles.Base
import Oracles.Flag (when)
import Oracles.Builder
import Targets
-- import Switches
import Switches
import Expression.Settings
import Util
-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
librarySettings :: Ways -> Settings
librarySettings ways = msum
[ whenExists Ways.vanilla ways ?? ( arg "--enable-library-vanilla"
, arg "--disable-library-vanilla" )
, (ghcWithInterpreter
&& not dynamicGhcPrograms
&& whenExists Ways.vanilla ways) ?? ( arg "--enable-library-for-ghci"
, arg "--disable-library-for-ghci" )
, whenExists Ways.profiling ways ?? ( arg "--enable-library-profiling"
, arg "--disable-library-profiling" )
, whenExists Ways.dynamic ways ?? ( arg "--enable-shared"
, arg "--disable-shared" )]
librarySettings waysExpression = do
ways <- waysExpression
ghcInterp <- ghcWithInterpreter
dynPrograms <- dynamicGhcPrograms
return $ [ if Ways.vanilla `elem` ways
then "--enable-library-vanilla"
else "--disable-library-vanilla"
, if Ways.vanilla `elem` ways && ghcInterp && not dynPrograms
then "--enable-library-for-ghci"
else "--disable-library-for-ghci"
, if Ways.profiling `elem` ways
then "--enable-library-profiling"
else "--disable-library-profiling"
, if Ways.dynamic `elem` ways
then "--enable-shared"
else "--disable-shared" ]
configureSettings :: Settings
configureSettings =
let conf key = argPrefix ("--configure-option=" ++ key ++ "=")
. argConcatSpace
in
msum [ conf "CFLAGS" ccSettings
, conf "LDFLAGS" ldSettings
, conf "CPPFLAGS" cppSettings
, argPrefix "--gcc-options=" $
argConcatSpace (ccSettings <|> ldSettings)
-- TODO: drop if empty
, conf "--with-iconv-includes" (argConfig "iconv-include-dirs")
, conf "--with-iconv-libraries" (argConfig "iconv-lib-dirs")
, conf "--with-gmp-includes" (argConfig "gmp-include-dirs")
, conf "--with-gmp-libraries" (argConfig "gmp-lib-dirs")
-- TODO: why TargetPlatformFull and not host?
, crossCompiling ?
conf "--host" (argConfig "target-platform-full")
, conf "--with-cc" (argStagedBuilderPath Gcc) ]
configureSettings = do
let conf key expr = do
value <- liftM unwords expr
return $ if value == ""
then []
else ["--configure-option=" ++ key ++ "=" ++ value]
stage <- asks getStage
gccPath <- lift $ showArg (Gcc stage)
gccSettings <- liftM unwords (ccSettings <> ldSettings)
mconcat [ conf "CFLAGS" ccSettings
, conf "LDFLAGS" ldSettings
, conf "CPPFLAGS" cppSettings
, arg $ "--gcc-options=" ++ gccSettings
, conf "--with-iconv-includes" (argConfig "iconv-include-dirs")
, conf "--with-iconv-libraries" (argConfig "iconv-lib-dirs")
, conf "--with-gmp-includes" (argConfig "gmp-include-dirs")
, conf "--with-gmp-libraries" (argConfig "gmp-lib-dirs")
-- TODO: why TargetPlatformFull and not host?
, crossCompiling ?
conf "--host" (argConfig "target-platform-full")
, conf "--with-cc" (arg gccPath) ]
bootPackageDbSettings :: Settings
bootPackageDbSettings =
argPrefix "--package-db="
(argConcatPath $ argConfig "ghc-source-path" |>
argPath "libraries/bootstrapping.conf")
bootPackageDbSettings = do
sourcePath <- lift $ askConfig "ghc-source-path"
return $ ["--package-db=" ++ sourcePath </> "libraries/bootstrapping.conf"]
dllSettings :: Settings
dllSettings = arg ""
with' :: Builder -> Settings
with' builder = lift $ with builder
packageConstraints :: Settings
packageConstraints = do
pkgs <- filterM packagePredicate targetPackages
constraints <- lift $ forM pkgs $ \pkg -> do
let cabal = pkgPath pkg </> pkgCabal pkg
prefix = dropExtension (pkgCabal pkg) ++ " == "
need [cabal]
content <- lines <$> liftIO (readFile cabal)
let vs = filter (("ersion:" `isPrefixOf`) . drop 1) content
case vs of
[v] -> return $ prefix ++ dropWhile (not . isDigit) v
_ -> redError $ "Cannot determine package version in '"
++ cabal ++ "'."
return $ concatMap (\c -> ["--constraint", c]) $ constraints
cabalSettings :: Settings
cabalSettings =
mproduct
[ arg "configure" -- start with builder, e.g. argBuilderPath GhcCabal?
, argBuildPath
, argBuildDir
, dllSettings
, msum
[ argWithStagedBuilder Ghc -- TODO: used to be limited to max stage1 GHC
, argWithStagedBuilder GhcPkg
, customConfigureSettings
, stage Stage0 ? bootPackageDbSettings
, librarySettings targetWays
, configNonEmpty "hscolour" ? argWithBuilder HsColour -- TODO: generalise
, configureSettings
, stage Stage0 ? argPackageConstraints targetPackages
, argWithStagedBuilder Gcc
, notStage Stage0 ? argWithBuilder Ld
, argWithBuilder Ar
, argWithBuilder Alex
, argWithBuilder Happy ]] -- TODO: reorder with's
cabalSettings = do
stage <- asks getStage
pkg <- asks getPackage
mconcat [ arg "configure"
, arg $ pkgPath pkg
, arg $ targetDirectory stage pkg
, dllSettings
, with' $ Ghc stage
, with' $ GhcPkg stage
, customConfigureSettings
, Expression.stage Stage0 ? bootPackageDbSettings
, librarySettings targetWays
, configKeyNonEmpty "hscolour" ? with' HsColour -- TODO: generalise?
, configureSettings
, Expression.stage Stage0 ? packageConstraints
, with' $ Gcc stage
, notStage Stage0 ? with' Ld
, with' Ar
, with' Alex
, with' Happy ] -- TODO: reorder with's
ghcPkgSettings :: Settings
ghcPkgSettings =
arg "update" |> msum
[ arg "--force"
, argConcatPath $
msum [argBuildPath, argBuildDir, arg "inplace-pkg-config"]
, bootPackageDbSettings ]
ghcPkgSettings = do
stage <- asks getStage
pkg <- asks getPackage
let dir = pkgPath pkg </> targetDirectory stage pkg
mconcat [ arg "update"
, arg "--force"
, Expression.stage Stage0 ? bootPackageDbSettings
, arg $ dir </> "inplace-pkg-config" ]
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
-- 1) Drop lines containing '$'
......@@ -121,24 +152,21 @@ buildPackageData stage pkg dir ways settings =
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
] &%> \_ -> do
let configure = pkgPath pkg </> "configure"
env = defaultEnvironment { getStage = stage, getPackage = pkg }
need [pkgPath pkg </> pkgCabal pkg]
-- GhcCabal will run the configure script, so we depend on it
-- We still don't know who build the configure script from configure.ac
when (doesFileExist $ configure <.> "ac") $ need [configure]
run' GhcCabal settings
run' env GhcCabal settings
-- TODO: when (registerPackage settings) $
run' (GhcPkg stage) settings
run' env (GhcPkg stage) settings
postProcessPackageData $ dir </> "package-data.mk"
run' :: Builder -> Settings -> Action ()
run' builder settings = do
settings' <- evaluate (project builder settings)
case fromSettings settings' of
Nothing ->
redError $ "Cannot determine " ++ show builder ++ " settings."
Just args -> do
putColoured Green (show args)
run builder args
run' :: Environment -> Builder -> Settings -> Action ()
run' env builder settings = do
args <- interpret (env {getBuilder = builder}) settings
putColoured Green (show args)
run builder args
--buildRule :: Package -> TodoItem -> Rules ()
--buildRule pkg @ (Package name path cabal _) todo @ (stage, dist, settings) =
......@@ -165,22 +193,24 @@ run' builder settings = do
-- run (GhcPkg stage) $ ghcPkgArgs pkg todo
-- postProcessPackageData $ pathDist </> "package-data.mk"
buildSettings = + builder Gcc ? ccSettings
-- buildSettings = + builder Gcc ? ccSettings
builder Gcc ? "-tricky-flag"
-- builder Gcc ? "-tricky-flag"
ccSettings :: Settings
ccSettings = msum
[ package integerLibrary ? argPath "-Ilibraries/integer-gmp2/gmp"
, builder GhcCabal ? argStagedConfig "conf-cc-args"
, validating ? msum
[ not (builder GhcCabal) ? arg "-Werror"
, arg "-Wall"
, gccIsClang ??
( arg "-Wno-unknown-pragmas" <|>
not gccLt46 ? windowsHost ? arg "-Werror=unused-but-set-variable"
, not gccLt46 ? arg "-Wno-error=inline" )]
]
ccSettings = do
let gccGe46 = liftM not gccLt46
mconcat
[ package integerLibrary ? arg "-Ilibraries/integer-gmp2/gmp"
, builder GhcCabal ? argStagedConfig "conf-cc-args"
, validating ? mconcat
[ notBuilder GhcCabal ? arg "-Werror"
, arg "-Wall"
, gccIsClang ??
( arg "-Wno-unknown-pragmas" <>
gccGe46 ? windowsHost ? arg "-Werror=unused-but-set-variable"
, gccGe46 ? arg "-Wno-error=inline" )]
]
ldSettings :: Settings
ldSettings = builder GhcCabal ? argStagedConfig "conf-gcc-linker-args"
......
......@@ -6,6 +6,7 @@ import Base
import Package
import Rules.Data
import Expression
import Expression.Settings
buildPackage :: Stage -> Package -> FilePath -> Ways -> Settings -> Rules ()
buildPackage = buildPackageData
......@@ -6,11 +6,12 @@ module Settings (
import Base hiding (arg, args, Args)
import Rules.Data
import Switches
import Oracles.Builder
import Expression.Base
import Expression
import Expression.Settings
buildSettings :: Settings
buildSettings = msum
[ builder GhcCabal ? cabalSettings
, stagedBuilder GhcPkg ? ghcPkgSettings ]
buildSettings = do
stage <- asks getStage
mconcat [ builder GhcCabal ? cabalSettings
, builder (GhcPkg stage) ? ghcPkgSettings ]
......@@ -8,14 +8,13 @@ module Switches (
gccIsClang, gccLt46, windowsHost, notWindowsHost
) where
import Base
import Expression
-- User-defined switches
buildHaddock :: Monad m => Predicate m
buildHaddock :: Predicate
buildHaddock = return True
validating :: Monad m => Predicate m
validating :: Predicate
validating = return False
-- Support for multiple integer library implementations
......@@ -25,28 +24,28 @@ integerLibraryImpl :: IntegerLibraryImpl
integerLibraryImpl = IntegerGmp2
-- Predicates based on configuration files
supportsPackageKey :: Predicate Action
supportsPackageKey :: Predicate
supportsPackageKey = configKeyYes "supports-package-key"
targetPlatforms :: [String] -> Predicate Action
targetPlatforms :: [String] -> Predicate
targetPlatforms = configKeyValues "target-platform-full"
targetPlatform :: String -> Predicate Action
targetPlatform :: String -> Predicate
targetPlatform s = targetPlatforms [s]
targetOss :: [String] -> Predicate Action
targetOss :: [String] -> Predicate
targetOss = configKeyValues "target-os"
targetOs :: String -> Predicate Action
targetOs :: String -> Predicate
targetOs s = targetOss [s]
notTargetOs :: String -> Predicate Action
notTargetOs = fmap not . targetOs
notTargetOs :: String -> Predicate
notTargetOs = liftM not . targetOs
targetArchs :: [String] -> Predicate Action
targetArchs :: [String] -> Predicate
targetArchs = configKeyValues "target-arch"
platformSupportsSharedLibs :: Predicate Action
platformSupportsSharedLibs :: Predicate
platformSupportsSharedLibs = do
badPlatform <- targetPlatforms [ "powerpc-unknown-linux"
, "x86_64-unknown-mingw32"
......@@ -55,10 +54,10 @@ platformSupportsSharedLibs = do
solarisBroken <- configKeyYes "solaris-broken-shld"
return $ not (badPlatform || solaris && solarisBroken)
dynamicGhcPrograms :: Predicate Action
dynamicGhcPrograms :: Predicate
dynamicGhcPrograms = configKeyYes "dynamic-ghc-programs"
ghcWithInterpreter :: Predicate Action
ghcWithInterpreter :: Predicate
ghcWithInterpreter = do
goodOs <- targetOss [ "mingw32", "cygwin32", "linux", "solaris2"
, "freebsd", "dragonfly", "netbsd", "openbsd"
......@@ -67,17 +66,17 @@ ghcWithInterpreter = do
, "sparc64", "arm" ]
return $ goodOs && goodArch
crossCompiling :: Predicate Action
crossCompiling :: Predicate
crossCompiling = configKeyYes "cross-compiling"
gccIsClang :: Predicate Action
gccIsClang :: Predicate
gccIsClang = configKeyYes "gcc-is-clang"
gccLt46 :: Predicate Action
gccLt46 :: Predicate
gccLt46 = configKeyYes "gcc-lt-46"
windowsHost :: Predicate Action
windowsHost :: Predicate
windowsHost = configKeyValues "host-os-cpp" ["mingw32", "cygwin32"]
notWindowsHost :: Predicate Action
notWindowsHost = fmap not windowsHost
notWindowsHost :: Predicate
notWindowsHost = liftM not windowsHost
module Targets (
targetWays, targetPackages, targetDirectories,
targetWays, targetPackages, targetDirectory, packagePredicate,
customConfigureSettings,
array, base, binPackageDb, binary, bytestring, cabal, containers, deepseq,
directory, filepath, ghcPrim, haskeline, hoopl, hpc, integerLibrary,
......@@ -15,28 +15,42 @@ import Expression
import Expression.Settings
-- These are the packages we build
targetPackages :: Packages Action
targetPackages = mconcat
[ stage Stage0 ? packagesStage0
, stage Stage1 ? packagesStage1 ]
targetPackages :: [Package]
targetPackages =
[ array, base, binPackageDb, binary, bytestring, cabal, compiler
, containers, deepseq, directory, filepath, ghcPrim, haskeline
, hoopl, hpc, integerLibrary, parallel, pretty, primitive, process
, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml ]
packagesStage0 :: Packages Action
packagesStage0 = mconcat
[ return [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
, notWindowsHost ? notTargetOs "ios" ? return [terminfo] ]
packagesStage1 :: Packages Action
packagesStage1 = mconcat
[ packagesStage0
, return [ array, base, bytestring, containers, deepseq, directory
, filepath, ghcPrim, haskeline, integerLibrary, parallel
, pretty, primitive, process, stm, templateHaskell, time ]
, notWindowsHost ? return [unix]
, windowsHost ? return [win32]
, buildHaddock ? return [xhtml] ]
-- Some packages are built conditionally
-- TODO: make this function total (it only reads stage from the environment)
packagePredicate :: Package -> Predicate
packagePredicate pkg = do
stage <- asks getStage
windows <- windowsHost
ios <- targetOs "ios"
haddock <- buildHaddock
let result
| stage == Stage0 && pkg `notElem`
[ binPackageDb
, binary
, cabal
, compiler
, hoopl
, hpc
, terminfo
, transformers ] = False
| pkg == terminfo = not windows && not ios
| pkg == unix = not windows
| pkg == win32 = windows
| pkg == xhtml = haddock
| stage == Stage0 = True
| stage == Stage1 = True
| otherwise = False -- TODO: enable Stage2
return result
-- Packages will be build these ways
targetWays :: Ways Action
targetWays :: Ways
targetWays = mconcat
[ return [Ways.vanilla] -- always build vanilla
, notStage Stage0 ? return [Ways.profiling]
......@@ -47,15 +61,11 @@ targetWays = mconcat
-- * build/ : contains compiled object code
-- * doc/ : produced by haddock
-- * package-data.mk : contains output of ghc-cabal applied to pkgCabal
targetDirectories :: Monad m => TargetDir m
targetDirectories = do
stage <- asks getStage
package <- asks getPackage
let targetDir
| package == compiler = "stage" ++ show (succ stage)
| stage == Stage0 = "dist-boot"
| otherwise = "dist-install"
return targetDir
targetDirectory :: Stage -> Package -> FilePath
targetDirectory stage package
| package == compiler = "stage" ++ show (1 + fromEnum stage)
| stage == Stage0 = "dist-boot"
| otherwise = "dist-install"
-- Package definitions
array, base, binPackageDb, binary, bytestring, cabal, containers, deepseq,
......@@ -106,7 +116,7 @@ integerLibraryCabal = case integerLibraryImpl of
IntegerSimple -> "integer-simple.cabal"
-- Custom configure settings for packages
customConfigureSettings :: Settings Action
customConfigureSettings :: Settings
customConfigureSettings = mconcat
[ package base ? arg ("--flags=" ++ integerLibraryName)
, package ghcPrim ? arg "--flag=include-ghc-prim"
......
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