[commit: ghc] wip/nfs-locking: Add support for autoconf/configure chain. (7d90047)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:44:42 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/7d90047a4fad755726ba70cc7f9506512008b96f/ghc
>---------------------------------------------------------------
commit 7d90047a4fad755726ba70cc7f9506512008b96f
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Fri Dec 26 22:38:42 2014 +0000
Add support for autoconf/configure chain.
>---------------------------------------------------------------
7d90047a4fad755726ba70cc7f9506512008b96f
cfg/default.config.in | 9 ++-------
src/Base.hs | 1 +
src/Config.hs | 18 ++++++++++--------
src/Oracles.hs | 44 ++++++++++++++++++++++++++++++++++----------
4 files changed, 47 insertions(+), 25 deletions(-)
diff --git a/cfg/default.config.in b/cfg/default.config.in
index c01bb87..d3617f4 100644
--- a/cfg/default.config.in
+++ b/cfg/default.config.in
@@ -1,5 +1,5 @@
# Paths to builders:
-# ==================
+#===================
system-ghc = @WithGhc@
system-ghc-pkg = @GhcPkgCmd@
@@ -32,7 +32,7 @@ lax-dependencies = NO
dynamic-ghc-programs = NO
# Information about host and target systems:
-# ==========================================
+#===========================================
target-os = @TargetOS_CPP@
target-arch = @TargetArch_CPP@
@@ -69,8 +69,3 @@ iconv-lib-dirs = @ICONV_LIB_DIRS@
gmp-include-dirs = @GMP_INCLUDE_DIRS@
gmp-lib-dirs = @GMP_LIB_DIRS@
-
-
-
-
-
diff --git a/src/Base.hs b/src/Base.hs
index 7e130c2..e44b3bb 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -5,6 +5,7 @@ module Base (
module Development.Shake.FilePath,
module Control.Applicative,
module Data.Monoid,
+ module Data.List,
Stage (..),
Args, arg, Condition,
joinArgs, joinArgsWithSpaces,
diff --git a/src/Config.hs b/src/Config.hs
index a370f38..3d26482 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -1,5 +1,5 @@
module Config (
- autoconfRules, configureRules
+ autoconfRules, configureRules, cfgPath
) where
import Development.Shake
@@ -9,16 +9,18 @@ import Development.Shake.Rule
import Control.Applicative
import Control.Monad
import Base
-import Oracles
+
+cfgPath :: FilePath
+cfgPath = "shake" </> "cfg"
autoconfRules :: Rules ()
autoconfRules = do
- "shake/configure" %> \out -> do
- need ["shake/configure.ac"]
- cmd $ "bash shake/autoconf"
+ "configure" %> \out -> do
+ copyFile' (cfgPath </> "configure.ac") "configure.ac"
+ cmd "bash autoconf"
configureRules :: Rules ()
configureRules = do
- "shake/default.config" %> \out -> do
- need ["shake/default.config.in", "shake/configure"]
- cmd $ "bash shake/configure"
+ cfgPath </> "default.config" %> \out -> do
+ need [cfgPath </> "default.config.in", "configure"]
+ cmd "bash configure"
diff --git a/src/Oracles.hs b/src/Oracles.hs
index 9138780..971d5c6 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -20,7 +20,9 @@ import qualified System.Directory as System
import qualified Data.HashMap.Strict as M
import qualified Prelude
import Prelude hiding (not, (&&), (||))
+import Data.Char
import Base
+import Config
data Builder = Ar | Ld | Gcc | Alex | Happy | HsColour | GhcCabal | GhcPkg Stage | Ghc Stage
@@ -40,10 +42,18 @@ path builder = do
Ghc Stage3 -> "ghc-stage3"
GhcPkg Stage0 -> "system-ghc-pkg" -- GhcPkg Stage0 is the bootstrapping GhcPkg
GhcPkg _ -> "ghc-pkg" -- GhcPkg StageN, N > 0, is the one built on stage 0 (TODO: need only Stage1?)
- askConfigWithDefault key $
+ cfgPath <- askConfigWithDefault key $
error $ "\nCannot find path to '"
++ key
++ "' in configuration files."
+ let cfgPathExe = if cfgPath /= "" then cfgPath -<.> exe else ""
+ windows <- test WindowsHost
+ if (windows && "/" `isPrefixOf` cfgPathExe)
+ then do
+ root <- option Root
+ return $ root ++ cfgPathExe
+ else
+ return cfgPathExe
argPath :: Builder -> Args
argPath builder = do
@@ -53,7 +63,7 @@ argPath builder = do
-- Explain!
-- TODO: document change in behaviour (LaxDeps)
needBuilder :: Builder -> Action ()
-needBuilder ghc @ (Ghc _) = do
+needBuilder ghc @ (Ghc stage) = do
target <- path ghc
laxDeps <- test LaxDeps -- TODO: get rid of test?
if laxDeps then orderOnly [target] else need [target]
@@ -88,9 +98,18 @@ run builder args = do
data Option = TargetOS | TargetArch | TargetPlatformFull
| ConfCcArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfCppArgs Stage
| IconvIncludeDirs | IconvLibDirs | GmpIncludeDirs | GmpLibDirs
- | HostOsCpp
+ | HostOsCpp | Root
option :: Option -> Action String
+option Root = do
+ windows <- test WindowsHost
+ if (windows)
+ then do
+ Stdout out <- cmd ["cygpath", "-m", "/"]
+ return $ dropWhileEnd isSpace out
+ else
+ return "/"
+
option opt = askConfig $ case opt of
TargetOS -> "target-os"
TargetArch -> "target-arch"
@@ -112,6 +131,7 @@ argOption opt = do
data Flag = LaxDeps | Stage1Only | DynamicGhcPrograms | GhcWithInterpreter | HsColourSrcs
| GccIsClang | GccLt46 | CrossCompiling | Validating | PlatformSupportsSharedLibs
+ | WindowsHost
test :: Flag -> Action Bool
test GhcWithInterpreter = do
@@ -130,6 +150,10 @@ test HsColourSrcs = do
hscolour <- path HsColour
return $ hscolour /= ""
+test WindowsHost = do
+ hostOsCpp <- option HostOsCpp
+ return $ hostOsCpp `elem` ["mingw32", "cygwin32"]
+
test flag = do
(key, defaultValue) <- return $ case flag of
LaxDeps -> ("lax-dependencies" , False) -- TODO: move flags to a separate file
@@ -230,19 +254,19 @@ askConfig key = askConfigWithDefault key $ error $ "\nCannot find key '"
oracleRules :: Rules ()
oracleRules = do
cfg <- newCache $ \() -> do
- unless (doesFileExist "shake/default.config") $ do
+ unless (doesFileExist $ cfgPath </> "default.config.in") $ do
error $ "\nDefault configuration file '"
- ++ "shake/default.config.in"
+ ++ (cfgPath </> "default.config.in")
++ "' is missing; unwilling to proceed."
return ()
- need ["shake/default.config"]
- cfgDefault <- liftIO $ readConfigFile "shake/default.config"
- existsUser <- doesFileExist "shake/user.config"
+ need [cfgPath </> "default.config"]
+ cfgDefault <- liftIO $ readConfigFile $ cfgPath </> "default.config"
+ existsUser <- doesFileExist $ cfgPath </> "user.config"
cfgUser <- if existsUser
- then liftIO $ readConfigFile "shake/user.config"
+ then liftIO $ readConfigFile $ cfgPath </> "user.config"
else do
putLoud $ "\nUser defined configuration file '"
- ++ "shake/user.config"
+ ++ (cfgPath </> "user.config")
++ "' is missing; proceeding with default configuration.\n"
return M.empty
return $ cfgUser `M.union` cfgDefault
More information about the ghc-commits
mailing list