Commit 72f6ec65 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Turn Configure into a Builder.

parent e6373a06
......@@ -72,6 +72,7 @@ executable hadrian
, Settings.Builders.Ar
, Settings.Builders.Common
, Settings.Builders.Cc
, Settings.Builders.Configure
, Settings.Builders.DeriveConstants
, Settings.Builders.GenApply
, Settings.Builders.GenPrimopCode
......
{-# LANGUAGE DeriveGeneric, LambdaCase #-}
module Builder (
CompilerMode (..), Builder (..),
isStaged, builderPath, getBuilderPath, specified, needBuilder
builderPath, getBuilderPath, specified, needBuilder
) where
import Control.Monad.Trans.Reader
......@@ -35,6 +35,7 @@ data Builder = Alex
| Ar
| DeriveConstants
| Cc CompilerMode Stage
| Configure FilePath
| GenApply
| GenPrimopCode
| Ghc CompilerMode Stage
......@@ -82,13 +83,6 @@ builderProvenance = \case
isInternal :: Builder -> Bool
isInternal = isJust . builderProvenance
isStaged :: Builder -> Bool
isStaged = \case
(Cc _ _) -> True
(Ghc _ _) -> True
(GhcPkg _) -> True
_ -> False
-- TODO: Some builders are required only on certain platforms. For example,
-- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
-- support for platform-specific optional builders as soon as we can reliably
......@@ -100,38 +94,40 @@ isOptional = \case
_ -> False
-- TODO: get rid of fromJust
-- | Determine the location of a 'Builder'
-- | Determine the location of a 'Builder'.
builderPath :: Builder -> Action FilePath
builderPath builder = case builderProvenance builder of
Just context -> return . fromJust $ programPath context
Nothing -> do
let builderKey = case builder of
Alex -> "alex"
Ar -> "ar"
Cc _ Stage0 -> "system-cc"
Cc _ _ -> "cc"
Ghc _ Stage0 -> "system-ghc"
GhcPkg Stage0 -> "system-ghc-pkg"
Happy -> "happy"
HsColour -> "hscolour"
HsCpp -> "hs-cpp"
Ld -> "ld"
Make -> "make"
Nm -> "nm"
Objdump -> "objdump"
Patch -> "patch"
Perl -> "perl"
Ranlib -> "ranlib"
Tar -> "tar"
_ -> error $ "Cannot determine builderKey for " ++ show builder
path <- askConfigWithDefault builderKey . putError $
"\nCannot find path to '" ++ builderKey
++ "' in system.config file. Have you forgot to run configure?"
Nothing -> case builder of
Alex -> fromKey "alex"
Ar -> fromKey "ar"
Cc _ Stage0 -> fromKey "system-cc"
Cc _ _ -> fromKey "cc"
-- We can't ask configure for the path to configure!
Configure _ -> return "bash configure"
Ghc _ Stage0 -> fromKey "system-ghc"
GhcPkg Stage0 -> fromKey "system-ghc-pkg"
Happy -> fromKey "happy"
HsColour -> fromKey "hscolour"
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"
Tar -> fromKey "tar"
_ -> error $ "Cannot determine builderPath for " ++ show builder
where
fromKey key = do
path <- askConfigWithDefault key . putError $ "\nCannot find path to '"
++ key ++ "' in system.config file. Did you forget to run configure?"
if null path
then do
if isOptional builder
then return ""
else putError $ "Builder '" ++ builderKey ++ "' is not specified in"
else putError $ "Builder '" ++ key ++ "' is not specified in"
++ " system.config file. Cannot proceed without it."
else fixAbsolutePathOnWindows =<< lookupInPath path
......@@ -143,9 +139,11 @@ specified = fmap (not . null) . builderPath
-- | Make sure a Builder exists on the given path and rebuild it if out of date.
needBuilder :: Builder -> Action ()
needBuilder builder = when (isInternal builder) $ do
path <- builderPath builder
need [path]
needBuilder = \case
Configure dir -> need [dir -/- "configure"]
builder -> when (isInternal builder) $ do
path <- builderPath builder
need [path]
-- Instances for storing in the Shake database
instance Binary CompilerMode
......
......@@ -19,14 +19,27 @@ package p = (p ==) <$> getPackage
class BuilderLike a where
builder :: a -> Predicate
-- TODO: Move this elsewhere to avoid orhpan instances
instance BuilderLike Builder where
builder b = (b ==) <$> getBuilder
instance BuilderLike a => BuilderLike (Stage -> a) where
builder stagedBuilder = builder . stagedBuilder =<< getStage
builder s2b = builder . s2b =<< getStage
instance BuilderLike a => BuilderLike (CompilerMode -> a) where
builder compiler = anyM (builder . compiler) [Compile, FindDependencies, Link]
builder c2b = do
b <- getBuilder
case b of
Cc c _ -> builder $ c2b c
Ghc c _ -> builder $ c2b c
_ -> return False
instance BuilderLike a => BuilderLike (FilePath -> a) where
builder f2b = do
b <- getBuilder
case b of
Configure f -> builder $ f2b f
_ -> return False
-- | Does any of the output files match a given pattern?
file :: FilePattern -> Predicate
......
module Rules.Actions (
build, buildWithResources, copyFile, createDirectory, removeDirectory,
copyDirectory, moveDirectory, applyPatch, fixFile, runConfigure, runMake,
build, buildWithResources, buildWithCmdOptions, copyFile, createDirectory,
removeDirectory, copyDirectory, moveDirectory, applyPatch, fixFile, runMake,
runMakeVerbose, renderLibrary, renderProgram, runBuilder, makeExecutable
) where
......@@ -19,11 +19,25 @@ import Settings.Args
import Settings.Builders.Ar
import Target
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
-- built (that is, track changes in the build system).
-- | Build a 'Target' with the right 'Builder' and command line arguments.
-- Force a rebuild if the argument list has changed since the last build.
build :: Target -> Action ()
build = customBuild [] []
-- | Build a 'Target' with the right 'Builder' and command line arguments,
-- acquiring necessary resources. Force a rebuild if the argument list has
-- changed since the last build.
buildWithResources :: [(Resource, Int)] -> Target -> Action ()
buildWithResources rs target@Target {..} = do
buildWithResources rs = customBuild rs []
-- | Build a 'Target' with the right 'Builder' and command line arguments,
-- using given options when executing the build command. Force a rebuild if
-- the argument list has changed since the last build.
buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
buildWithCmdOptions = customBuild []
customBuild :: [(Resource, Int)] -> [CmdOption] -> Target -> Action ()
customBuild rs opts target@Target {..} = do
needBuilder builder
path <- builderPath builder
argList <- interpret target getArgs
......@@ -41,7 +55,12 @@ buildWithResources rs target@Target {..} = do
else do
input <- interpret target getInput
top <- topDirectory
cmd [path] [Cwd output] "x" (top -/- input)
cmd [Cwd output] [path] "x" (top -/- input)
Configure dir -> do
need [dir -/- "configure"]
let env = AddEnv "CONFIG_SHELL" "/bin/bash"
cmd Shell (EchoStdout False) [Cwd dir] [path] (env:opts) argList
HsCpp -> captureStdout target path argList
GenApply -> captureStdout target path argList
......@@ -55,10 +74,6 @@ buildWithResources rs target@Target {..} = do
_ -> cmd [path] argList
-- Most targets are built without explicitly acquiring resources
build :: Target -> Action ()
build = buildWithResources []
captureStdout :: Target -> FilePath -> [String] -> Action ()
captureStdout target path argList = do
file <- interpret target getOutput
......@@ -104,22 +119,6 @@ fixFile file f = do
return new
liftIO $ writeFile file contents
runConfigure :: FilePath -> [CmdOption] -> [String] -> Action ()
runConfigure dir opts args = do
need [dir -/- "configure"]
let args' = filter (not . null) args
note = if null args' then "" else " (" ++ intercalate ", " args' ++ ")"
-- Always configure with bash.
-- This also injects /bin/bash into `libtool`, instead of /bin/sh
opts' = opts ++ [AddEnv "CONFIG_SHELL" "/bin/bash"]
if dir == "."
then do
putBuild $ "| Run configure" ++ note ++ "..."
quietly $ cmd Shell (EchoStdout False) "bash configure" opts' args'
else do
putBuild $ "| Run configure" ++ note ++ " in " ++ dir ++ "..."
quietly $ cmd Shell (EchoStdout False) [Cwd dir] "bash configure" opts' args'
runMake :: FilePath -> [String] -> Action ()
runMake = runMakeWithVerbosity False
......
......@@ -46,14 +46,6 @@ configureEnvironment = do
path <- builderPath bld
return $ AddEnv var path
configureArguments :: Action [String]
configureArguments = do
hostPlatform <- setting HostPlatform
buildPlatform <- setting BuildPlatform
return [ "--enable-shared=no"
, "--host=" ++ hostPlatform
, "--build=" ++ buildPlatform]
-- TODO: we rebuild gmp every time.
gmpRules :: Rules ()
gmpRules = do
......@@ -98,11 +90,14 @@ gmpRules = do
putError $ "gmpRules: expected suffix " ++ suffix
++ " (found: " ++ filename ++ ")."
let libName = take (length filename - length suffix) filename
libPath = gmpBuildPath -/- libName
libPath = gmpBuildPath -/- "lib"
moveDirectory (gmpBuildPath -/- libName) libPath
envs <- configureEnvironment
args <- configureArguments
runConfigure libPath envs args
env <- configureEnvironment
buildWithCmdOptions env $
Target gmpContext (Configure libPath)
[libPath -/- "Makefile.in"] [libPath -/- "Makefile"]
runMake libPath ["MAKEFLAGS="]
......
......@@ -5,7 +5,6 @@ import Expression
import GHC
import Oracles.Config.Flag
import Oracles.Config.Setting
import Oracles.WindowsPath
import Rules.Actions
import Settings.Builders.Common
import Settings.Packages.Rts
......@@ -24,11 +23,11 @@ libffiDependencies = (rtsBuildPath -/-) <$> [ "ffi.h", "ffitarget.h" ]
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
libffiBuild :: FilePath
libffiBuild = buildRootPath -/- "stage1/libffi"
libffiLibrary :: FilePath
libffiLibrary = libffiBuild -/- "inst/lib/libffi.a"
libffiLibrary = libffiBuildPath -/- "inst/lib/libffi.a"
libffiMakefile :: FilePath
libffiMakefile = libffiBuildPath -/- "Makefile"
fixLibffiMakefile :: String -> String
fixLibffiMakefile =
......@@ -37,14 +36,15 @@ fixLibffiMakefile =
. replace "@INSTALL@" "$(subst ../install-sh,C:/msys/home/chEEtah/ghc/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 . fromDiffExpr $ mconcat
[ cArgs
, argStagedSettingList ConfCcArgs ]
ldFlags <- interpretInContext libffiContext $ fromDiffExpr ldArgs
sequence [ builderEnv "CC" $ Cc Compile Stage0
, builderEnv "CXX" $ Cc Compile Stage0
sequence [ builderEnv "CC" $ Cc Compile Stage1
, builderEnv "CXX" $ Cc Compile Stage1
, builderEnv "LD" Ld
, builderEnv "AR" Ar
, builderEnv "NM" Nm
......@@ -52,21 +52,11 @@ configureEnvironment = do
, return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w"
, return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
where
builderEnv var bld = do
needBuilder bld
path <- builderPath bld
builderEnv var b = do
needBuilder b
path <- builderPath b
return $ AddEnv var path
configureArguments :: Action [String]
configureArguments = do
top <- topDirectory
targetPlatform <- setting TargetPlatform
return [ "--prefix=" ++ top -/- libffiBuild -/- "inst"
, "--libdir=" ++ top -/- libffiBuild -/- "inst/lib"
, "--enable-static=yes"
, "--enable-shared=no" -- TODO: add support for yes
, "--host=" ++ targetPlatform ]
-- TODO: remove code duplication (need sourcePath)
-- TODO: split into multiple rules
libffiRules :: Rules ()
......@@ -82,7 +72,7 @@ libffiRules = do
copyFile (ffiIncludeDir -/- file) (rtsBuildPath -/- file)
putSuccess $ "| Successfully copied system FFI library header files"
else do
removeDirectory libffiBuild
removeDirectory libffiBuildPath
createDirectory $ buildRootPath -/- stageString Stage0
tarballs <- getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
......@@ -97,22 +87,23 @@ libffiRules = do
-- TODO: Simplify.
actionFinally (do
build $ Target libffiContext Tar tarballs [buildRootPath]
moveDirectory (buildRootPath -/- libname) libffiBuild) $
moveDirectory (buildRootPath -/- libname) libffiBuildPath) $
removeFiles buildRootPath [libname <//> "*"]
fixFile (libffiBuild -/- "Makefile.in") fixLibffiMakefile
fixFile (libffiMakefile <.> "in") fixLibffiMakefile
forM_ ["config.guess", "config.sub"] $ \file ->
copyFile file (libffiBuild -/- file)
copyFile file (libffiBuildPath -/- file)
envs <- configureEnvironment
args <- configureArguments
runConfigure libffiBuild envs args
env <- configureEnvironment
buildWithCmdOptions env $
Target libffiContext (Configure libffiBuildPath)
[libffiMakefile <.> "in"] [libffiMakefile]
runMake libffiBuild ["MAKEFLAGS="]
runMake libffiBuild ["MAKEFLAGS=", "install"]
runMake libffiBuildPath ["MAKEFLAGS="]
runMake libffiBuildPath ["MAKEFLAGS=", "install"]
let ffiHDir = libffiBuild -/- "inst/lib" -/- libname -/- "include"
let ffiHDir = libffiBuildPath -/- "inst/lib" -/- libname -/- "include"
forM_ ["ffi.h", "ffitarget.h"] $ \file -> do
copyFile (ffiHDir -/- file) (rtsBuildPath -/- file)
......
......@@ -3,16 +3,20 @@ module Rules.Setup (setupRules) where
import qualified System.Info
import Base
import Builder
import CmdLineFlag
import Context
import GHC (compiler)
import Rules.Actions
import Rules.Generators.GhcAutoconfH
import Stage
import Target
setupRules :: Rules ()
setupRules = do
[configFile, "settings", configH] &%> \[cfg, settings, cfgH] -> do
need [ settings <.> "in", cfgH <.> "in", "configure" ]
[configFile, "settings", configH] &%> \outs -> do
case cmdSetup of
RunSetup configureArgs -> do
RunSetup _ -> do
-- We cannot use windowsHost here due to a cyclic dependency
when (System.Info.os == "mingw32") $ do
putBuild "| Checking for Windows tarballs..."
......@@ -20,9 +24,12 @@ setupRules = do
, "mk/get-win32-tarballs.sh"
, "download"
, System.Info.arch ]
runConfigure "." [] [configureArgs]
SkipSetup -> unlessM (doesFileExist cfg) $
putError $ "Configuration file " ++ cfg ++ " is missing."
let srcs = map (<.> "in") outs
context = vanillaContext Stage0 compiler
need srcs
build $ Target context (Configure ".") srcs outs
SkipSetup -> unlessM (doesFileExist configFile) $
putError $ "Configuration file " ++ configFile ++ " is missing."
++ "\nRun the configure script either manually or via the "
++ "build system by passing --setup[=CONFIGURE_ARGS] flag."
......
......@@ -6,6 +6,7 @@ import Settings.Builders.Alex
import Settings.Builders.Ar
import Settings.Builders.DeriveConstants
import Settings.Builders.Cc
import Settings.Builders.Configure
import Settings.Builders.GenApply
import Settings.Builders.GenPrimopCode
import Settings.Builders.Ghc
......@@ -51,6 +52,7 @@ defaultBuilderArgs = mconcat
[ alexBuilderArgs
, arBuilderArgs
, ccBuilderArgs
, configureArgs
, deriveConstantsBuilderArgs
, genApplyBuilderArgs
, genPrimopCodeBuilderArgs
......
module Settings.Builders.Configure (configureArgs) where
import Base
import CmdLineFlag
import Expression
import Oracles.Config.Setting
import Predicates (builder)
import Settings
configureArgs :: Args
configureArgs = mconcat
[ builder (Configure ".") ? case cmdSetup of
RunSetup setup -> arg setup
_ -> mempty
, builder (Configure libffiBuildPath) ? do
top <- getTopDirectory
targetPlatform <- getSetting TargetPlatform
mconcat [ arg $ "--prefix=" ++ top -/- libffiBuildPath -/- "inst"
, arg $ "--libdir=" ++ top -/- libffiBuildPath -/- "inst/lib"
, arg $ "--enable-static=yes"
, arg $ "--enable-shared=no" -- TODO: add support for yes
, arg $ "--host=" ++ targetPlatform ]
, builder (Configure $ gmpBuildPath -/- "lib") ? do
hostPlatform <- getSetting HostPlatform
buildPlatform <- getSetting BuildPlatform
mconcat [ arg $ "--enable-shared=no"
, arg $ "--host=" ++ hostPlatform
, arg $ "--build=" ++ buildPlatform ] ]
......@@ -2,7 +2,7 @@ module Settings.Paths (
contextDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
pkgLibraryFile0, pkgGhciLibraryFile, gmpBuildPath, gmpBuildInfoPath,
packageDbDirectory, pkgConfFile, shakeFilesPath, bootPackageConstraints,
packageDependencies
packageDependencies, libffiBuildPath
) where
import Base
......@@ -67,6 +67,10 @@ pkgFile context prefix suffix = do
componentId <- pkgData $ ComponentId path
return $ path ~/~ prefix ++ componentId ++ suffix
-- | Build directory for in-tree libffi library.
libffiBuildPath :: FilePath
libffiBuildPath = buildRootPath -/- "stage1/libffi"
-- | Build directory for in-tree GMP library.
gmpBuildPath :: FilePath
gmpBuildPath = buildRootPath ~/~ "stage1/gmp"
......
......@@ -81,7 +81,7 @@ buildHaddock = return cmdBuildHaddock
-- this is a Predicate, hence you can enable verbose output for a chosen package
-- only, e.g.: verboseCommands = package ghcPrim
verboseCommands :: Predicate
verboseCommands = return False
verboseCommands = builder Configure
-- TODO: Replace with stage2 ? arg "-Werror"?
-- | To enable -Werror in Stage2 set turnWarningsIntoErrors = stage2.
......
Supports Markdown
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