Implement generation of PrimopWrappers.hs. Work on generating Config.hs.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Wed, 23 Sep 2015 01:10:25 +0000 (02:10 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Wed, 23 Sep 2015 01:10:25 +0000 (02:10 +0100)
src/Rules/Generate.hs

index 535f99b..a12f6a8 100644 (file)
@@ -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"
+
+