[commit: ghc] wip/nfs-locking: Generate includes/ghcautoconf.h, refactor Rules/Generate.hs. (6b7b9cc)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:29:46 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/6b7b9cc86e963a4bc200ff45fe16e26b72f372dd/ghc
>---------------------------------------------------------------
commit 6b7b9cc86e963a4bc200ff45fe16e26b72f372dd
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sat Dec 26 03:00:03 2015 +0000
Generate includes/ghcautoconf.h, refactor Rules/Generate.hs.
>---------------------------------------------------------------
6b7b9cc86e963a4bc200ff45fe16e26b72f372dd
src/Main.hs | 6 ++++--
src/Rules/Generate.hs | 33 +++++++++++++++++++++++++--------
src/Rules/Generators/GhcAutoconfH.hs | 34 ++++++++++++++++++++++++++++++++++
3 files changed, 63 insertions(+), 10 deletions(-)
diff --git a/src/Main.hs b/src/Main.hs
index 7a0205d..0dc8d96 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,15 +2,17 @@ import Base
import Rules
import Rules.Cabal
import Rules.Config
+import Rules.Generate
import Rules.Oracles
main :: IO ()
main = shakeArgs options $ do
- generateTargets -- see Rules
- packageRules -- see Rules
cabalRules -- see Rules.Cabal
configRules -- see Rules.Config
+ generateTargets -- see Rules
+ generateRules -- see Rules.Generate
oracleRules -- see Rules.Oracles
+ packageRules -- see Rules
where
options = shakeOptions
{ shakeFiles = shakeFilesPath
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 13d149e1..8f60dd0 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,8 +1,9 @@
-module Rules.Generate (generatePackageCode) where
+module Rules.Generate (generatePackageCode, generateRules) where
import Expression
import GHC
import Rules.Generators.ConfigHs
+import Rules.Generators.GhcAutoconfH
import Rules.Generators.VersionHs
import Rules.Generators.PlatformH
import Oracles.ModuleFiles
@@ -25,6 +26,13 @@ determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
where
ext = takeExtension file
+generate :: FilePath -> PartialTarget -> Expr String -> Action ()
+generate file target expr = do
+ contents <- interpretPartial target expr
+ writeFileChanged file contents
+ putBuild $ "| Successfully generated '" ++ file ++ "'."
+
+
generatePackageCode :: Resources -> PartialTarget -> Rules ()
generatePackageCode _ target @ (PartialTarget stage pkg) =
let path = targetPath stage pkg
@@ -32,10 +40,7 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
primopsTxt = targetPath stage compiler -/- "build/primops.txt"
platformH = targetPath stage compiler -/- "ghc_boot_platform.h"
generated f = (buildPath ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
- generate file expr = do
- contents <- interpretPartial target expr
- writeFileChanged file contents
- putBuild $ "| Successfully generated '" ++ file ++ "'."
+ file <~ gen = generate file target gen
in do
generated ?> \file -> do
let pattern = "//" ++ takeBaseName file <.> "*"
@@ -66,14 +71,26 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
priority 2.0 $ do
when (pkg == ghcPkg) $ buildPath -/- "Config.hs" %> \file -> do
- generate file generateConfigHs
+ file <~ generateConfigHs
when (pkg == ghcPkg) $ buildPath -/- "Version.hs" %> \file -> do
- generate file generateVersionHs
+ file <~ generateVersionHs
when (pkg == compiler) $ platformH %> \file -> do
- generate file generatePlatformH
+ file <~ generatePlatformH
when (pkg == runghc) $ buildPath -/- "Main.hs" %> \file -> do
copyFileChanged (pkgPath pkg -/- "runghc.hs") file
putBuild $ "| Successfully generated '" ++ file ++ "'."
+
+generateRules :: Rules ()
+generateRules = do
+ "includes/ghcautoconf.h" <~ generateGhcAutoconfH
+ where
+ file <~ gen = file %> \out -> generate out fakeTarget gen
+
+-- TODO: Use the Types, Luke! (drop partial function)
+fakeTarget :: PartialTarget
+fakeTarget = PartialTarget (error "fakeTarget: unknown stage")
+ (error "fakeTarget: unknown package")
+
diff --git a/src/Rules/Generators/GhcAutoconfH.hs b/src/Rules/Generators/GhcAutoconfH.hs
new file mode 100644
index 0000000..6d49603
--- /dev/null
+++ b/src/Rules/Generators/GhcAutoconfH.hs
@@ -0,0 +1,34 @@
+module Rules.Generators.GhcAutoconfH (generateGhcAutoconfH) where
+
+import Expression
+import Oracles
+
+-- TODO: change `mk/config.h` to `shake-build/cfg/config.h`
+configH :: FilePath
+configH = "mk/config.h"
+
+undefinePackage :: String -> String
+undefinePackage s
+ | "#define PACKAGE_" `isPrefixOf` s
+ = "/* #undef " ++ takeWhile (/=' ') (drop 8 s) ++ " */"
+ | otherwise = s
+
+generateGhcAutoconfH :: Expr String
+generateGhcAutoconfH = do
+ lift $ need [sourcePath -/- "Rules/Generators/GhcAutoconfH.hs"]
+ configHContents <- lift $ map undefinePackage <$> readFileLines configH
+ tablesNextToCode <- lift $ ghcEnableTablesNextToCode
+ ghcUnreg <- getFlag GhcUnregisterised
+ ccLlvmBackend <- getSetting CcLlvmBackend
+ ccClangBackend <- getSetting CcClangBackend
+ return . unlines $
+ [ "#ifndef __GHCAUTOCONF_H__"
+ , "#define __GHCAUTOCONF_H__" ]
+ ++ configHContents ++
+ [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ]
+ ++
+ [ "\n#define llvm_CC_FLAVOR 1" | ccLlvmBackend == "1" ]
+ ++
+ [ "\n#define clang_CC_FLAVOR 1" | ccClangBackend == "1" ]
+ ++
+ [ "#endif /* __GHCAUTOCONF_H__ */" ]
More information about the ghc-commits
mailing list