[commit: ghc] wip/nfs-locking: Implement generation of PrimopWrappers.hs. Work on generating Config.hs. (7e4f903)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:21:33 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/7e4f9033115b8f0591b3a1e4541b8dd6a4c9d633/ghc

>---------------------------------------------------------------

commit 7e4f9033115b8f0591b3a1e4541b8dd6a4c9d633
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Sep 23 02:10:25 2015 +0100

    Implement generation of PrimopWrappers.hs. Work on generating Config.hs.


>---------------------------------------------------------------

7e4f9033115b8f0591b3a1e4541b8dd6a4c9d633
 src/Rules/Generate.hs | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 92 insertions(+), 1 deletion(-)

diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 535f99b..a12f6a8 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -6,6 +6,9 @@ import Rules.Actions
 import Rules.Resources
 import Settings
 
+primops :: FilePath
+primops = "compiler/stage1/build/primops.txt"
+
 -- The following generators and corresponding source extensions are supported:
 knownGenerators :: [ (Builder, String) ]
 knownGenerators =  [ (Alex   , ".x"  )
@@ -31,7 +34,95 @@ generatePackageCode _ target @ (PartialTarget stage package) =
             let gens = [ (f, b) | f <- files, Just b <- [determineBuilder f] ]
             when (length gens /= 1) . putError $
                 "Exactly one generator expected for " ++ file
-                ++ "(found: " ++ show gens ++ ")."
+                ++ " (found: " ++ show gens ++ ")."
             let (src, builder) = head gens
             need [src]
             build $ fullTarget target builder [src] [file]
+
+        path -/- "build/GHC/PrimopWrappers.hs" %> \file -> do
+            need [primops]
+            build $ fullTarget target GenPrimopCode [primops] [file]
+
+        priority 2.0 $ path -/- "build/Config.hs" %> \file -> do
+            config <- generateConfig
+            writeFileChanged file config
+
+generateConfig :: Action String
+generateConfig = do
+    cProjectName        <- setting ProjectName
+    cProjectGitCommitId <- setting ProjectGitCommitId
+    cProjectVersion     <- setting ProjectVersion
+    cProjectVersionInt  <- setting ProjectVersionInt
+    cProjectPatchLevel  <- setting ProjectPatchLevel
+    cProjectPatchLevel1 <- setting ProjectPatchLevel1
+    cProjectPatchLevel2 <- setting ProjectPatchLevel2
+    cBooterVersion      <- setting GhcVersion
+    cIntegerLibraryType <- case integerLibrary of
+        integerGmp    -> return "IntegerGMP"
+        integerSimple -> return "IntegerSimple"
+        _ -> putError $ "Unknown integer library: " ++ integerLibrary ++ "."
+    cSupportsSplitObjs  <- yesNo splitObjects
+    return "{-# LANGUAGE CPP #-}\n"
+        ++ "module Config where\n"
+        ++ "\n"
+        ++ "#include \"ghc_boot_platform.h\"\n"
+        ++ "\n"
+        ++ "data IntegerLibrary = IntegerGMP\n"
+        ++ "                    | IntegerSimple\n"
+        ++ "                    deriving Eq\n"
+        ++ "\n"
+        ++ "cBuildPlatformString :: String\n"
+        ++ "cBuildPlatformString = BuildPlatform_NAME\n"
+        ++ "cHostPlatformString :: String\n"
+        ++ "cHostPlatformString = HostPlatform_NAME\n"
+        ++ "cTargetPlatformString :: String\n"
+        ++ "cTargetPlatformString = TargetPlatform_NAME\n"
+        ++ "\n"
+        ++ "cProjectName          :: String\n"
+        ++ "cProjectName          = " ++ cProjectName ++ "\n"
+        ++ "cProjectGitCommitId   :: String\n"
+        ++ "cProjectGitCommitId   = " ++ cProjectGitCommitId ++ "\n"
+        ++ "cProjectVersion       :: String\n"
+        ++ "cProjectVersion       = " ++ cProjectVersion ++ "\n"
+        ++ "cProjectVersionInt    :: String\n"
+        ++ "cProjectVersionInt    = " ++ cProjectVersionInt ++ "\n"
+        ++ "cProjectPatchLevel    :: String\n"
+        ++ "cProjectPatchLevel    = " ++ cProjectPatchLevel ++ "\n"
+        ++ "cProjectPatchLevel1   :: String\n"
+        ++ "cProjectPatchLevel1   = " ++ cProjectPatchLevel1 ++ "\n"
+        ++ "cProjectPatchLevel2   :: String\n"
+        ++ "cProjectPatchLevel2   = " ++ cProjectPatchLevel2 ++ "\n"
+        ++ "cBooterVersion        :: String\n"
+        ++ "cBooterVersion        = " ++ cBooterVersion ++ "\n"
+        ++ "cStage                :: String\n"
+        ++ "cStage                = show (STAGE :: Int)\n"
+        ++ "cIntegerLibrary       :: String\n"
+        ++ "cIntegerLibrary       = " ++ pkgName integerLibrary ++ "\n"
+        ++ "cIntegerLibraryType   :: IntegerLibrary\n"
+        ++ "cIntegerLibraryType   = " ++ cIntegerLibraryType ++ "\n"
+        ++ "cSupportsSplitObjs    :: String\n"
+        ++ "cSupportsSplitObjs    = " ++ cSupportsSplitObjs ++ "\n"
+        ++ "cGhcWithInterpreter   :: String\n"
+        ++ "cGhcWithInterpreter   = "YES"\n"
+        ++ "cGhcWithNativeCodeGen :: String\n"
+        ++ "cGhcWithNativeCodeGen = "YES"\n"
+        ++ "cGhcWithSMP           :: String\n"
+        ++ "cGhcWithSMP           = "YES"\n"
+        ++ "cGhcRTSWays           :: String\n"
+        ++ "cGhcRTSWays           = "l debug thr thr_debug thr_l thr_p "\n"
+        ++ "cGhcEnableTablesNextToCode :: String\n"
+        ++ "cGhcEnableTablesNextToCode = "YES"\n"
+        ++ "cLeadingUnderscore    :: String\n"
+        ++ "cLeadingUnderscore    = "NO"\n"
+        ++ "cGHC_UNLIT_PGM        :: String\n"
+        ++ "cGHC_UNLIT_PGM        = "unlit.exe"\n"
+        ++ "cGHC_SPLIT_PGM        :: String\n"
+        ++ "cGHC_SPLIT_PGM        = "ghc-split"\n"
+        ++ "cLibFFI               :: Bool\n"
+        ++ "cLibFFI               = False\n"
+        ++ "cGhcThreaded :: Bool\n"
+        ++ "cGhcThreaded = True\n"
+        ++ "cGhcDebugged :: Bool\n"
+        ++ "cGhcDebugged = False\n"
+
+



More information about the ghc-commits mailing list