[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:46:43 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