[commit: ghc] wip/nfs-locking: Generate files with DeriveConstants (#39). (c6cfb36)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:48:02 UTC 2017


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

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

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

commit c6cfb36c2d7ca4f76d3da54d06b40fb86890e7ef
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Dec 27 01:53:52 2015 +0000

    Generate files with DeriveConstants (#39).


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

c6cfb36c2d7ca4f76d3da54d06b40fb86890e7ef
 src/Rules/Actions.hs                     | 29 +++++++++++----------
 src/Rules/Generate.hs                    | 22 ++++++++++++++--
 src/Settings/Args.hs                     |  2 ++
 src/Settings/Builders/DeriveConstants.hs | 44 ++++++++++++++++++++++++++++++++
 src/Settings/Builders/GhcCabal.hs        |  1 +
 5 files changed, 82 insertions(+), 16 deletions(-)

diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index 5a3d113..30ae742 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -47,20 +47,21 @@ build = buildWithResources []
 
 interestingInfo :: Builder -> [String] -> [String]
 interestingInfo builder ss = case builder of
-    Alex     -> prefixAndSuffix 0 3 ss
-    Ar       -> prefixAndSuffix 2 1 ss
-    Gcc _    -> prefixAndSuffix 0 4 ss
-    GccM _   -> prefixAndSuffix 0 1 ss
-    Ghc _    -> prefixAndSuffix 0 4 ss
-    GhcCabal -> prefixAndSuffix 3 0 ss
-    GhcM _   -> prefixAndSuffix 1 1 ss
-    GhcPkg _ -> prefixAndSuffix 3 0 ss
-    Haddock  -> prefixAndSuffix 1 0 ss
-    Happy    -> prefixAndSuffix 0 3 ss
-    Hsc2Hs   -> prefixAndSuffix 0 3 ss
-    HsCpp    -> prefixAndSuffix 0 1 ss
-    Ld       -> prefixAndSuffix 4 0 ss
-    _        -> ss
+    Alex            -> prefixAndSuffix 0 3 ss
+    Ar              -> prefixAndSuffix 2 1 ss
+    DeriveConstants -> prefixAndSuffix 3 0 ss
+    Gcc _           -> prefixAndSuffix 0 4 ss
+    GccM _          -> prefixAndSuffix 0 1 ss
+    Ghc _           -> prefixAndSuffix 0 4 ss
+    GhcCabal        -> prefixAndSuffix 3 0 ss
+    GhcM _          -> prefixAndSuffix 1 1 ss
+    GhcPkg _        -> prefixAndSuffix 3 0 ss
+    Haddock         -> prefixAndSuffix 1 0 ss
+    Happy           -> prefixAndSuffix 0 3 ss
+    Hsc2Hs          -> prefixAndSuffix 0 3 ss
+    HsCpp           -> prefixAndSuffix 0 1 ss
+    Ld              -> prefixAndSuffix 4 0 ss
+    _               -> ss
   where
     prefixAndSuffix n m list =
         let len = length list in
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index e427dfd..2121a9c 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,4 +1,6 @@
-module Rules.Generate (generatePackageCode, generateRules) where
+module Rules.Generate (
+    generatePackageCode, generateRules, includesDependencies
+    ) where
 
 import Expression
 import GHC
@@ -15,6 +17,19 @@ import Settings
 primopsSource :: FilePath
 primopsSource = "compiler/prelude/primops.txt.pp"
 
+derivedConstantsPath :: FilePath
+derivedConstantsPath = "includes/dist-derivedconstants/header"
+
+-- TODO: can we drop COMPILER_INCLUDES_DEPS += $(includes_GHCCONSTANTS)?
+includesDependencies :: [FilePath]
+includesDependencies =
+    [ "includes/ghcautoconf.h"
+    , "includes/ghcplatform.h"
+    , derivedConstantsPath -/- "DerivedConstants.h"
+    , derivedConstantsPath -/- "GHCConstantsHaskellType.hs"
+    , derivedConstantsPath -/- "GHCConstantsHaskellWrappers.hs"
+    , derivedConstantsPath -/- "GHCConstantsHaskellExports.hs" ]
+
 -- The following generators and corresponding source extensions are supported:
 knownGenerators :: [ (Builder, String) ]
 knownGenerators =  [ (Alex   , ".x"  )
@@ -33,7 +48,6 @@ generate file target expr = do
     writeFileChanged file contents
     putSuccess $ "| Successfully generated '" ++ file ++ "'."
 
-
 generatePackageCode :: Resources -> PartialTarget -> Rules ()
 generatePackageCode _ target @ (PartialTarget stage pkg) =
     let path        = targetPath stage pkg
@@ -71,6 +85,10 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
                 build $ fullTarget target GenPrimopCode [primopsTxt] [file]
 
         priority 2.0 $ do
+            when (pkg == compiler && stage == Stage1) $
+                derivedConstantsPath ++ "//*" %> \file -> do
+                    build $ fullTarget target DeriveConstants [] [file]
+
             when (pkg == compiler) $ buildPath -/- "Config.hs" %> \file -> do
                 file <~ generateConfigHs
 
diff --git a/src/Settings/Args.hs b/src/Settings/Args.hs
index 231f5ed..5419f51 100644
--- a/src/Settings/Args.hs
+++ b/src/Settings/Args.hs
@@ -3,6 +3,7 @@ module Settings.Args (getArgs) where
 import Expression
 import Settings.Builders.Alex
 import Settings.Builders.Ar
+import Settings.Builders.DeriveConstants
 import Settings.Builders.Gcc
 import Settings.Builders.GenPrimopCode
 import Settings.Builders.Ghc
@@ -32,6 +33,7 @@ defaultArgs = mconcat
     , arArgs
     , cabalArgs
     , customPackageArgs
+    , deriveConstantsArgs
     , gccArgs
     , gccMArgs
     , genPrimopCodeArgs
diff --git a/src/Settings/Builders/DeriveConstants.hs b/src/Settings/Builders/DeriveConstants.hs
new file mode 100644
index 0000000..4353875
--- /dev/null
+++ b/src/Settings/Builders/DeriveConstants.hs
@@ -0,0 +1,44 @@
+module Settings.Builders.DeriveConstants (
+    derivedConstantsPath, deriveConstantsArgs
+    ) where
+
+import Expression
+import Oracles.Config.Flag
+import Oracles.Config.Setting
+import Predicates (builder, file)
+import Settings.Builders.GhcCabal
+
+derivedConstantsPath :: FilePath
+derivedConstantsPath = "includes/dist-derivedconstants/header"
+
+-- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
+deriveConstantsArgs :: Args
+deriveConstantsArgs = builder DeriveConstants ? do
+    cFlags <- fromDiffExpr includeCcArgs
+    mconcat
+        [ file "//DerivedConstants.h"             ? arg "--gen-header"
+        , file "//GHCConstantsHaskellType.hs"     ? arg "--gen-haskell-type"
+        , file "//platformConstants"              ? arg "--gen-haskell-value"
+        , file "//GHCConstantsHaskellWrappers.hs" ? arg "--gen-haskell-wrappers"
+        , file "//GHCConstantsHaskellExports.hs"  ? arg "--gen-haskell-exports"
+        , arg "-o", arg =<< getOutput
+        , arg "--tmpdir", arg derivedConstantsPath
+        , arg "--gcc-program", arg =<< getBuilderPath (Gcc Stage1)
+        , append . concat $ map (\a -> ["--gcc-flag", a]) cFlags
+        , arg "--nm-program", arg =<< getBuilderPath Nm
+        , specified Objdump ? mconcat [ arg "--objdump-program"
+                                      , arg =<< getBuilderPath Objdump ]
+        , arg "--target-os", arg =<< getSetting TargetOs ]
+
+includeCcArgs :: Args
+includeCcArgs = do
+    confCcArgs <- lift . settingList $ ConfCcArgs Stage1
+    mconcat
+        [ ccArgs
+        , ccWarnings
+        , append confCcArgs
+        , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
+        , append $ map ("-I" ++) ghcIncludeDirs -- TODO: fix code duplication
+        , arg "-Irts"
+        , notM ghcWithSMP ? arg "-DNOSMP"
+        , arg "-fcommon" ]
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 80c4f4c..cec876a 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -208,6 +208,7 @@ argStagedBuilderPath :: (Stage -> Builder) -> Args
 argStagedBuilderPath sb = (argM . builderPath . sb) =<< getStage
 
 -- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
+-- TODO: simplify
 appendCcArgs :: [String] -> Args
 appendCcArgs xs = do
     mconcat [ stagedBuilder Gcc  ? append xs



More information about the ghc-commits mailing list