[commit: ghc] wip/nfs-locking: Adds ghc-split generator, generateScripts and re-enables SplitObjects (7470e5d)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:03:56 UTC 2017


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

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

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

commit 7470e5d6f71ef5a662e8b0b1791683a03cbbebb8
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Sat Jan 9 14:39:14 2016 +0800

    Adds ghc-split generator, generateScripts and re-enables SplitObjects
    
    Fixes #84.


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

7470e5d6f71ef5a662e8b0b1791683a03cbbebb8
 shaking-up-ghc.cabal             |  1 +
 src/Main.hs                      |  1 +
 src/Rules/Generate.hs            | 37 +++++++++++++++++++++++++++++++++++--
 src/Rules/Generators/GhcSplit.hs | 25 +++++++++++++++++++++++++
 src/Settings/User.hs             |  3 ++-
 5 files changed, 64 insertions(+), 3 deletions(-)

diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal
index 066b9e7..bd6e31f 100644
--- a/shaking-up-ghc.cabal
+++ b/shaking-up-ghc.cabal
@@ -47,6 +47,7 @@ executable ghc-shake
                        , Rules.Generators.GhcAutoconfH
                        , Rules.Generators.GhcBootPlatformH
                        , Rules.Generators.GhcPlatformH
+                       , Rules.Generators.GhcSplit
                        , Rules.Generators.GhcVersionH
                        , Rules.Generators.VersionHs
                        , Rules.IntegerGmp
diff --git a/src/Main.hs b/src/Main.hs
index 1710b39..a56f9ed 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -19,6 +19,7 @@ main = shakeArgs options rules
         , Rules.Config.configRules
         , Rules.Generate.copyRules
         , Rules.Generate.generateRules
+        , Rules.Generate.generateScripts
         , Rules.generateTargets
         , Rules.IntegerGmp.integerGmpRules
         , Rules.Libffi.libffiRules
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 71d88b1..3b6dfdc 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,5 +1,5 @@
 module Rules.Generate (
-    generatePackageCode, generateRules,
+    generatePackageCode, generateRules, generateScripts,
     derivedConstantsPath, generatedDependencies,
     installTargets, copyRules
     ) where
@@ -11,6 +11,7 @@ import Rules.Generators.ConfigHs
 import Rules.Generators.GhcAutoconfH
 import Rules.Generators.GhcBootPlatformH
 import Rules.Generators.GhcPlatformH
+import Rules.Generators.GhcSplit
 import Rules.Generators.GhcVersionH
 import Rules.Generators.VersionHs
 import Oracles.ModuleFiles
@@ -80,7 +81,7 @@ compilerDependencies stage =
 
 generatedDependencies :: Stage -> Package -> [FilePath]
 generatedDependencies stage pkg
-    | pkg   == compiler = compilerDependencies stage
+    | pkg   == compiler = compilerDependencies stage ++ ["inplace/lib/bin/ghc-split"]
     | pkg   == ghcPrim  = ghcPrimDependencies stage
     | pkg   == rts      = includesDependencies ++ derivedConstantsDependencies
     | stage == Stage0   = defaultDependencies
@@ -104,6 +105,13 @@ generate file target expr = do
     writeFileChanged file contents
     putSuccess $ "| Successfully generated '" ++ file ++ "'."
 
+-- | Generates @file@ for @target@ and marks it as executable.
+generateExec :: FilePath -> PartialTarget -> Expr String -> Action ()
+generateExec file target expr = do
+    generate file target expr
+    unit $ cmd "chmod +x " [file]
+    putSuccess $ "| Made '" ++ file ++ "' executable."
+
 generatePackageCode :: Resources -> PartialTarget -> Rules ()
 generatePackageCode _ target @ (PartialTarget stage pkg) =
     let buildPath   = targetPath stage pkg -/- "build"
@@ -177,6 +185,31 @@ generateRules = do
   where
     file <~ gen = file %> \out -> generate out emptyTarget gen
 
+-- | Generate scripts the build system requires. For now we generate the
+-- @ghc-split@ script from it's literate perl source.
+generateScripts :: Rules ()
+generateScripts = do
+    -- how to translate literate perl to perl.
+    -- this is a hack :-/
+    "//*.prl" %> \out -> do
+        let src = out -<.> "lprl"
+        path <- builderPath Unlit
+        need [path]
+        unit $ cmd [path] [src] [out]
+
+    -- ghc-split is only a perl script.
+    let ghcSplit = "inplace/lib/ghc-split" -- See system.config
+    let ghcSplitBin = "inplace/lib/bin/ghc-split" -- See ConfigHs.hs
+
+    ghcSplit <~ generateGhcSplit
+
+    ghcSplitBin %> \out -> do
+        need [ghcSplit]
+        copyFileChanged ghcSplit out
+
+  where
+    file <~ gen = file %> \out -> generateExec out emptyTarget gen
+
 -- TODO: Use the Types, Luke! (drop partial function)
 -- We sometimes need to evaluate expressions that do not require knowing all
 -- information about the target. In this case, we don't want to know anything.
diff --git a/src/Rules/Generators/GhcSplit.hs b/src/Rules/Generators/GhcSplit.hs
new file mode 100644
index 0000000..77cd49f
--- /dev/null
+++ b/src/Rules/Generators/GhcSplit.hs
@@ -0,0 +1,25 @@
+module Rules.Generators.GhcSplit (generateGhcSplit) where
+
+import Base
+import Expression
+import Oracles
+import Settings.User
+
+generateGhcSplit :: Expr String
+generateGhcSplit = do
+    let yesNo = lift . fmap (\x -> if x then "YES" else "NO")
+    perl <- getBuilderPath Perl
+    let script = "driver" -/- "split" -/- "ghc-split.prl"
+    when trackBuildSystem . lift $
+        need [sourcePath -/- "Rules" -/- "Generators" -/- "GhcSplit.hs"]
+    lift $ need [script]
+    targetPlatform <- getSetting TargetPlatform
+    ghcEnableTNC   <- yesNo ghcEnableTablesNextToCode
+    contents       <- lift $ readFileLines script
+    return . unlines $
+        [ "#!" ++ perl
+        , "$TARGETPLATFORM = \"" ++ targetPlatform ++ "\";"
+        -- I don't see where the ghc-split tool uses TNC, but
+        -- it's in the build-perl macro.
+        , "$TABLES_NEXT_TO_CODE = \"" ++ ghcEnableTNC ++ "\";"
+        ] ++ contents
diff --git a/src/Settings/User.hs b/src/Settings/User.hs
index 7a877ce..6ba7155 100644
--- a/src/Settings/User.hs
+++ b/src/Settings/User.hs
@@ -9,6 +9,7 @@ module Settings.User (
 import GHC
 import Expression
 import Predicates
+import Settings.Default
 
 -- Control user-specific settings
 userArgs :: Args
@@ -59,7 +60,7 @@ validating = False
 
 -- To switch off split objects change to 'return False'
 splitObjects :: Predicate
-splitObjects = return False -- FIXME: should be defaultSplitObjects, see #84.
+splitObjects = defaultSplitObjects
 
 dynamicGhcPrograms :: Bool
 dynamicGhcPrograms = False



More information about the ghc-commits mailing list