Refactor package-specific settings (#622)
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 15 Jun 2018 00:15:47 +0000 (01:15 +0100)
committerGitHub <noreply@github.com>
Fri, 15 Jun 2018 00:15:47 +0000 (01:15 +0100)
* Minor clean up

* Track rts.cabal

* Move all package-specific settings to Settings.Packages, plus another revision, see #540

* Drop Rules.PackageData

29 files changed:
hadrian.cabal
src/Base.hs
src/Context.hs
src/Context/Path.hs [moved from src/Context/Paths.hs with 68% similarity]
src/GHC.hs
src/Rules.hs
src/Rules/Configure.hs
src/Rules/Generate.hs
src/Rules/Gmp.hs
src/Rules/Libffi.hs
src/Rules/PackageData.hs [deleted file]
src/Rules/Program.hs
src/Rules/Register.hs
src/Settings/Builders/Configure.hs
src/Settings/Builders/Make.hs
src/Settings/Default.hs
src/Settings/Packages.hs
src/Settings/Packages/Base.hs [deleted file]
src/Settings/Packages/Cabal.hs [deleted file]
src/Settings/Packages/Compiler.hs [deleted file]
src/Settings/Packages/Ghc.hs [deleted file]
src/Settings/Packages/GhcCabal.hs [deleted file]
src/Settings/Packages/GhcPkg.hs [deleted file]
src/Settings/Packages/GhcPrim.hs [deleted file]
src/Settings/Packages/Ghci.hs [deleted file]
src/Settings/Packages/Haddock.hs [deleted file]
src/Settings/Packages/IntegerGmp.hs [deleted file]
src/Settings/Packages/Rts.hs [deleted file]
src/Settings/Packages/RunGhc.hs [deleted file]

index ef90c74..9c8e134 100644 (file)
@@ -22,7 +22,7 @@ executable hadrian
                        , Builder
                        , CommandLine
                        , Context
                        , Builder
                        , CommandLine
                        , Context
-                       , Context.Paths
+                       , Context.Path
                        , Context.Type
                        , Environment
                        , Expression
                        , Context.Type
                        , Environment
                        , Expression
@@ -55,7 +55,6 @@ executable hadrian
                        , Rules.Clean
                        , Rules.Compile
                        , Rules.Configure
                        , Rules.Clean
                        , Rules.Compile
                        , Rules.Configure
-                       , Rules.PackageData
                        , Rules.Dependencies
                        , Rules.Documentation
                        , Rules.Generate
                        , Rules.Dependencies
                        , Rules.Documentation
                        , Rules.Generate
@@ -94,7 +93,6 @@ executable hadrian
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
                        , Settings.Packages
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
                        , Settings.Packages
-                       , Settings.Packages.Rts
                        , Settings.Warnings
                        , Stage
                        , Target
                        , Settings.Warnings
                        , Stage
                        , Target
index 430078d..32fb979 100644 (file)
@@ -20,12 +20,11 @@ module Base (
 
     -- * Files
     configH, ghcVersionH,
 
     -- * Files
     configH, ghcVersionH,
+
     -- * Paths
     hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
     -- * Paths
     hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
-    generatedDir, generatedPath,
-    stageBinPath, stageLibPath,
-    templateHscPath, ghcDeps,
-    relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
+    generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath,
+    ghcDeps, relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
     ) where
 
 import Control.Applicative
     ) where
 
 import Control.Applicative
index 0694eb1..9142125 100644 (file)
@@ -13,7 +13,7 @@ module Context (
     ) where
 
 import Base
     ) where
 
 import Base
-import Context.Paths
+import Context.Path
 import Context.Type
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal
 import Context.Type
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal
@@ -78,6 +78,7 @@ pkgInplaceConfig context = do
     path <- contextPath context
     return $ path -/- "inplace-pkg-config"
 
     path <- contextPath context
     return $ path -/- "inplace-pkg-config"
 
+-- TODO: Add a @Rules FilePath@ alternative.
 -- | Path to the @setup-config@ of a given 'Context'.
 pkgSetupConfigFile :: Context -> Action FilePath
 pkgSetupConfigFile context = do
 -- | Path to the @setup-config@ of a given 'Context'.
 pkgSetupConfigFile :: Context -> Action FilePath
 pkgSetupConfigFile context = do
similarity index 68%
rename from src/Context/Paths.hs
rename to src/Context/Path.hs
index b023c4d..4bc9d9b 100644 (file)
@@ -1,17 +1,18 @@
-module Context.Paths where
+module Context.Path where
 
 import Base
 import Context.Type
 import Hadrian.Expression
 
 
 import Base
 import Context.Type
 import Hadrian.Expression
 
--- | The directory to the current stage
+-- | The build directory of the current 'Stage'.
 stageDir :: Context -> FilePath
 stageDir Context {..} = stageString stage
 
 stageDir :: Context -> FilePath
 stageDir Context {..} = stageString stage
 
--- | The path to the current stage
+-- | The build path of the current 'Stage'.
 stagePath :: Context -> Action FilePath
 stagePath context = buildRoot <&> (-/- stageDir context)
 
 stagePath :: Context -> Action FilePath
 stagePath context = buildRoot <&> (-/- stageDir context)
 
+-- | The expression that evaluates to the build path of the current 'Stage'.
 getStagePath :: Expr Context b FilePath
 getStagePath = expr . stagePath =<< getContext
 
 getStagePath :: Expr Context b FilePath
 getStagePath = expr . stagePath =<< getContext
 
@@ -19,10 +20,13 @@ getStagePath = expr . stagePath =<< getContext
 contextDir :: Context -> FilePath
 contextDir Context {..} = stageString stage -/- pkgPath package
 
 contextDir :: Context -> FilePath
 contextDir Context {..} = stageString stage -/- pkgPath package
 
--- | Path to the context directory, containing the "build folder"
+-- | The path to the directory in 'buildRoot' containing build artifacts of a
+-- given 'Context'.
 contextPath :: Context -> Action FilePath
 contextPath context = buildRoot <&> (-/- contextDir context)
 
 contextPath :: Context -> Action FilePath
 contextPath context = buildRoot <&> (-/- contextDir context)
 
+-- | The expression that evaluates to the path to the directory in 'buildRoot'
+-- containing build artifacts of a given 'Context'.
 getContextPath :: Expr Context b FilePath
 getContextPath = expr . contextPath =<< getContext
 
 getContextPath :: Expr Context b FilePath
 getContextPath = expr . contextPath =<< getContext
 
@@ -34,6 +38,6 @@ buildDir context = contextDir context -/- "build"
 buildPath :: Context -> Action FilePath
 buildPath context = buildRoot <&> (-/- buildDir context)
 
 buildPath :: Context -> Action FilePath
 buildPath context = buildRoot <&> (-/- buildDir context)
 
--- | Get the build path of the current 'Context'.
+-- | The expression that evaluates to the build path of the current 'Context'.
 getBuildPath :: Expr Context b FilePath
 getBuildPath = expr . buildPath =<< getContext
 getBuildPath :: Expr Context b FilePath
 getBuildPath = expr . buildPath =<< getContext
index d286ccb..9a160ce 100644 (file)
@@ -15,7 +15,8 @@ module GHC (
     programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
 
     -- * Miscellaneous
     programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
 
     -- * Miscellaneous
-    programPath, buildDll0
+    programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext,
+    libffiBuildPath, libffiLibraryName
     ) where
 
 import Base
     ) where
 
 import Base
@@ -174,3 +175,28 @@ buildDll0 :: Context -> Action Bool
 buildDll0 Context {..} = do
     windows <- windowsHost
     return $ windows && stage == Stage1 && package == compiler
 buildDll0 Context {..} = do
     windows <- windowsHost
     return $ windows && stage == Stage1 && package == compiler
+
+-- | RTS is considered a Stage1 package. This determines RTS build directory.
+rtsContext :: Context
+rtsContext = vanillaContext Stage1 rts
+
+-- | Path to the RTS build directory.
+rtsBuildPath :: Action FilePath
+rtsBuildPath = buildPath rtsContext
+
+-- | Libffi is considered a Stage1 package. This determines its build directory.
+libffiContext :: Context
+libffiContext = vanillaContext Stage1 libffi
+
+-- | Build directory for in-tree Libffi library.
+libffiBuildPath :: Action FilePath
+libffiBuildPath = buildPath libffiContext
+
+libffiLibraryName :: Action FilePath
+libffiLibraryName = do
+    useSystemFfi <- flag UseSystemFfi
+    windows      <- windowsHost
+    return $ case (useSystemFfi, windows) of
+        (True , False) -> "ffi"
+        (False, False) -> "Cffi"
+        (_    , True ) -> "Cffi-6"
index 7533a27..2bf4191 100644 (file)
@@ -17,7 +17,6 @@ import qualified Rules.Generate
 import qualified Rules.Gmp
 import qualified Rules.Libffi
 import qualified Rules.Library
 import qualified Rules.Gmp
 import qualified Rules.Libffi
 import qualified Rules.Library
-import qualified Rules.PackageData
 import qualified Rules.Program
 import qualified Rules.Register
 import Settings
 import qualified Rules.Program
 import qualified Rules.Register
 import Settings
@@ -108,15 +107,15 @@ packageRules = do
 
     Rules.Program.buildProgram readPackageDb
 
 
     Rules.Program.buildProgram readPackageDb
 
-    forM_ [Stage0 .. ] $ \stage -> do
-      -- we create a dummy context, that has the correct state, but contains
-      -- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
-      -- need to be set properly. @undefined@ is not an option as it ends up
-      -- being forced.
-      Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla)
+    forM_ [Stage0 .. ] $ \stage ->
+        -- we create a dummy context, that has the correct state, but contains
+        -- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
+        -- need to be set properly. @undefined@ is not an option as it ends up
+        -- being forced.
+        Rules.Register.registerPackage writePackageDb (Context stage dummyPackage vanilla)
 
     forM_ vanillaContexts $ mconcat
 
     forM_ vanillaContexts $ mconcat
-        [ Rules.PackageData.buildPackageData
+        [ Rules.Register.configurePackage
         , Rules.Dependencies.buildPackageDependencies readPackageDb
         , Rules.Documentation.buildPackageDocumentation
         , Rules.Generate.generatePackageCode ]
         , Rules.Dependencies.buildPackageDependencies readPackageDb
         , Rules.Documentation.buildPackageDocumentation
         , Rules.Generate.generatePackageCode ]
index 050d7f3..8cdc07d 100644 (file)
@@ -10,10 +10,15 @@ import GHC
 import Target
 import Utilities
 
 import Target
 import Utilities
 
+-- TODO: Make this list complete.
+-- | Files generated by running the @configure@ script.
+configureResults :: [FilePath]
+configureResults =
+    [ configFile, "settings", configH, "compiler/ghc.cabal", "rts/rts.cabal"]
+
 configureRules :: Rules ()
 configureRules = do
 configureRules :: Rules ()
 configureRules = do
-    -- TODO: consider other files we should track here, e.g. @rts/rts.cabal@.
-    [configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do
+    configureResults &%> \outs -> do
         skip <- not <$> cmdConfigure
         if skip
         then unlessM (doesFileExist configFile) $
         skip <- not <$> cmdConfigure
         if skip
         then unlessM (doesFileExist configFile) $
index e26e811..c6be43a 100644 (file)
@@ -6,14 +6,13 @@ module Rules.Generate (
 import Base
 import Expression
 import Flavour
 import Base
 import Expression
 import Flavour
-import GHC.Packages
+import GHC
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Rules.Gmp
 import Rules.Libffi
 import Settings
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Rules.Gmp
 import Rules.Libffi
 import Settings
-import Settings.Packages.Rts
 import Target
 import Utilities
 
 import Target
 import Utilities
 
index 9b45c0e..f1f0ee9 100644 (file)
@@ -82,7 +82,7 @@ gmpRules = do
     root <//> "gmp/config.mk" %> \_ -> do
         -- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
         -- Building anything in a package transitively depends on its configuration.
     root <//> "gmp/config.mk" %> \_ -> do
         -- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
         -- Building anything in a package transitively depends on its configuration.
-        setupConfig <- contextPath gmpContext <&> (-/- "setup-config")
+        setupConfig <- pkgSetupConfigFile gmpContext
         need [setupConfig]
 
     -- TODO: Get rid of hard-coded @gmp@.
         need [setupConfig]
 
     -- TODO: Get rid of hard-coded @gmp@.
index a51e758..834cbc6 100644 (file)
@@ -1,33 +1,30 @@
-module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
+module Rules.Libffi (libffiRules, libffiDependencies) where
 
 
-import GHC.Packages
+import GHC
 import Hadrian.Utilities
 import Settings.Builders.Common
 import Hadrian.Utilities
 import Settings.Builders.Common
-import Settings.Packages.Rts
 import Target
 import Utilities
 
 import Target
 import Utilities
 
--- | Libffi is considered a Stage1 package. This determines its build directory.
-libffiContext :: Context
-libffiContext = vanillaContext Stage1 libffi
-
--- | Build directory for in-tree Libffi library.
-libffiBuildPath :: Action FilePath
-libffiBuildPath = buildPath libffiContext
-
 libffiDependencies :: [FilePath]
 libffiDependencies = ["ffi.h", "ffitarget.h"]
 
 libffiLibrary :: FilePath
 libffiLibrary = "inst/lib/libffi.a"
 
 libffiDependencies :: [FilePath]
 libffiDependencies = ["ffi.h", "ffitarget.h"]
 
 libffiLibrary :: FilePath
 libffiLibrary = "inst/lib/libffi.a"
 
+rtsLibffiLibrary :: Way -> Action FilePath
+rtsLibffiLibrary way = do
+    name    <- libffiLibraryName
+    suf     <- libsuf way
+    rtsPath <- rtsBuildPath
+    return $ rtsPath -/- "lib" ++ name ++ suf
+
 fixLibffiMakefile :: FilePath -> String -> String
 fixLibffiMakefile top =
       replace "-MD" "-MMD"
     . replace "@toolexeclibdir@" "$(libdir)"
     . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
 
 fixLibffiMakefile :: FilePath -> String -> String
 fixLibffiMakefile top =
       replace "-MD" "-MMD"
     . replace "@toolexeclibdir@" "$(libdir)"
     . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
 
--- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs)
 -- TODO: check code duplication w.r.t. ConfCcArgs
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = do
 -- TODO: check code duplication w.r.t. ConfCcArgs
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = do
diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs
deleted file mode 100644 (file)
index 96e9960..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-module Rules.PackageData (buildPackageData) where
-
-import Base
-import Context
-import Expression
-import GHC.Packages
-import Settings.Packages.Rts
-import Target
-import Utilities
-
-import Hadrian.Haskell.Cabal.Parse (configurePackage)
-
--- | Build @setup-config@ and @inplace-pkg-config@ files
---   for packages. Look at the "Rules" module to see this
---   instantiated against all the packages.
-buildPackageData :: Context -> Rules ()
-buildPackageData context@Context {..} = do
-    root <- buildRootRules
-    let dir = root -/- contextDir context
-    dir -/- "setup-config" %> \_ -> configurePackage context
-
-    dir -/- "inplace-pkg-config" %> \conf -> do
-      when (package == rts) $ do
-        genPath <- buildRoot <&> (-/- generatedDir)
-        rtsPath <- rtsBuildPath
-        need [rtsConfIn]
-        build $ target context HsCpp [rtsConfIn] [conf]
-        fixFile conf $ unlines
-                     . map
-                     ( replace "\"\"" ""
-                     . replace "rts/dist/build" rtsPath
-                     . replace "includes/dist-derivedconstants/header" genPath )
-                     . lines
index 7b137f0..fb7179a 100644 (file)
@@ -10,7 +10,6 @@ import GHC
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Settings
 import Oracles.Flag
 import Oracles.ModuleFiles
 import Settings
-import Settings.Packages.Rts
 import Target
 import Utilities
 
 import Target
 import Utilities
 
index b66f085..677ee9f 100644 (file)
@@ -1,4 +1,7 @@
-module Rules.Register (registerPackages) where
+module Rules.Register (configurePackage, registerPackage) where
+
+import Distribution.ParseUtils
+import Distribution.Version (Version)
 
 import Base
 import Context
 
 import Base
 import Context
@@ -7,29 +10,36 @@ import Settings
 import Target
 import Utilities
 
 import Target
 import Utilities
 
-import Distribution.ParseUtils
-import qualified Distribution.Compat.ReadP as Parse
-import Distribution.Version (Version)
-import qualified System.Directory as IO
-
 import Hadrian.Expression
 import Hadrian.Expression
-import Hadrian.Haskell.Cabal.Parse as Cabal
+
+import qualified Distribution.Compat.ReadP   as Parse
+import qualified System.Directory            as IO
+import qualified Hadrian.Haskell.Cabal.Parse as Cabal
 
 parseCabalName :: String -> Maybe (String, Version)
 parseCabalName = readPToMaybe parse
 
 parseCabalName :: String -> Maybe (String, Version)
 parseCabalName = readPToMaybe parse
-  where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
+  where
+    parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
 
 
--- | Build rules for registering packages and initialising package databases
--- by running the @ghc-pkg@ utility.
-registerPackages :: [(Resource, Int)] -> Context -> Rules ()
-registerPackages rs context@Context {..} = do
+-- | Configure a package and build its @setup-config@ file.
+configurePackage :: Context -> Rules ()
+configurePackage context@Context {..} = do
     root <- buildRootRules
     root <- buildRootRules
-    root -/- relativePackageDbPath stage %> buildStamp rs context
+    root -/- contextDir context -/- "setup-config" %> \_ ->
+        Cabal.configurePackage context
 
 
+-- | Registering a package and initialise the corresponding package database if
+-- need be.
+registerPackage :: [(Resource, Int)] -> Context -> Rules ()
+registerPackage rs context@Context {..} = do
+    root <- buildRootRules
+
+    -- Initialise the package database.
     root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
         writeFileLines stamp []
 
     -- TODO: Add proper error handling for partial functions.
     root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
         writeFileLines stamp []
 
     -- TODO: Add proper error handling for partial functions.
+    -- Register a package.
     root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
         settings <- libPath context <&> (-/- "settings")
         platformConstants <- libPath context <&> (-/- "platformConstants")
     root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
         settings <- libPath context <&> (-/- "settings")
         platformConstants <- libPath context <&> (-/- "platformConstants")
@@ -46,9 +56,8 @@ buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 buildConf _ context@Context {..} _conf = do
     depPkgIds <- cabalDependencies context
 
 buildConf _ context@Context {..} _conf = do
     depPkgIds <- cabalDependencies context
 
-    -- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
-    -- Building anything in a package transitively depends on its configuration.
-    setupConfig <- contextPath context <&> (-/- "setup-config")
+    -- Calling 'need' on @setupConfig@, triggers the package configuration.
+    setupConfig <- pkgSetupConfigFile context
     need [setupConfig]
     need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
 
     need [setupConfig]
     need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
 
@@ -71,8 +80,8 @@ buildConf _ context@Context {..} _conf = do
     when (package == integerGmp) $ need [path -/- "ghc-gmp.h"]
 
     -- Copy and register the package.
     when (package == integerGmp) $ need [path -/- "ghc-gmp.h"]
 
     -- Copy and register the package.
-    copyPackage context
-    registerPackage context
+    Cabal.copyPackage context
+    Cabal.registerPackage context
 
 copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 copyConf rs context@Context {..} conf = do
 
 copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
 copyConf rs context@Context {..} conf = do
@@ -94,9 +103,3 @@ copyConf rs context@Context {..} conf = do
   where
     stdOutToPkgIds :: String -> [String]
     stdOutToPkgIds = drop 1 . concatMap words . lines
   where
     stdOutToPkgIds :: String -> [String]
     stdOutToPkgIds = drop 1 . concatMap words . lines
-
-buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildStamp rs Context {..} path = do
-    buildWithResources rs $
-        target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
-    putSuccess $ "| Successfully initialised " ++ path
index 93225b5..37442d4 100644 (file)
@@ -1,7 +1,7 @@
 module Settings.Builders.Configure (configureBuilderArgs) where
 
 module Settings.Builders.Configure (configureBuilderArgs) where
 
+import GHC
 import Rules.Gmp
 import Rules.Gmp
-import Rules.Libffi
 import Settings.Builders.Common
 
 configureBuilderArgs :: Args
 import Settings.Builders.Common
 
 configureBuilderArgs :: Args
index 6f8768d..f366b83 100644 (file)
@@ -3,7 +3,6 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where
 import GHC
 import Oracles.Setting
 import Rules.Gmp
 import GHC
 import Oracles.Setting
 import Rules.Gmp
-import Rules.Libffi
 import Settings.Builders.Common
 
 makeBuilderArgs :: Args
 import Settings.Builders.Common
 
 makeBuilderArgs :: Args
index 35bc1ac..f955139 100644 (file)
@@ -26,7 +26,6 @@ import Settings.Builders.Make
 import Settings.Builders.RunTest
 import Settings.Builders.Xelatex
 import Settings.Packages
 import Settings.Builders.RunTest
 import Settings.Builders.Xelatex
 import Settings.Packages
-import Settings.Packages.Rts
 import Settings.Warnings
 
 import {-# SOURCE #-} Builder
 import Settings.Warnings
 
 import {-# SOURCE #-} Builder
@@ -152,7 +151,4 @@ defaultBuilderArgs = mconcat
 
 -- | All 'Package'-dependent command line arguments.
 defaultPackageArgs :: Args
 
 -- | All 'Package'-dependent command line arguments.
 defaultPackageArgs :: Args
-defaultPackageArgs = mconcat
-    [ packageArgs
-    , rtsPackageArgs
-    , warningArgs ]
+defaultPackageArgs = mconcat [ packageArgs, warningArgs ]
index b221031..6a23bb7 100644 (file)
@@ -2,19 +2,19 @@ module Settings.Packages (packageArgs) where
 
 import Expression
 import Flavour
 
 import Expression
 import Flavour
-import GHC.Packages
+import GHC
 import Oracles.Setting
 import Oracles.Flag
 import Rules.Gmp
 import Settings
 
 import Oracles.Setting
 import Oracles.Flag
 import Rules.Gmp
 import Settings
 
--- TODO: Finish migration of package-specific settings into a single file.
+-- | Package-specific command-line arguments.
 packageArgs :: Args
 packageArgs = do
     intLib            <- getIntegerPackage
     stage             <- getStage
 packageArgs :: Args
 packageArgs = do
     intLib            <- getIntegerPackage
     stage             <- getStage
-    rtsWays           <- getRtsWays
     path              <- getBuildPath
     path              <- getBuildPath
+    rtsWays           <- getRtsWays
     compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler)
     gmpBuildPath      <- expr gmpBuildPath
 
     compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler)
     gmpBuildPath      <- expr gmpBuildPath
 
@@ -139,6 +139,14 @@ packageArgs = do
               arg ("--configure-option=CFLAGS=" ++ includeGmp)
             , arg ("--gcc-options="             ++ includeGmp) ] ]
 
               arg ("--configure-option=CFLAGS=" ++ includeGmp)
             , arg ("--gcc-options="             ++ includeGmp) ] ]
 
+        ---------------------------------- rts ---------------------------------
+        , package rts ? rtsPackageArgs -- RTS deserves a separate function
+
+        -------------------------------- runGhc --------------------------------
+        , package runGhc ?
+          builder Ghc ? input "//Main.hs" ?
+          (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
+
         --------------------------------- text ---------------------------------
         -- The package @text@ is rather tricky. It's a boot library, and it
         -- tries to determine on its own if it should link against @integer-gmp@
         --------------------------------- text ---------------------------------
         -- The package @text@ is rather tricky. It's a boot library, and it
         -- tries to determine on its own if it should link against @integer-gmp@
@@ -150,13 +158,205 @@ packageArgs = do
         -- in Stage1, and at that point the configuration is just wrong.
         , package text ?
           builder CabalFlags ? notStage0 ? intLib == integerSimple ?
         -- in Stage1, and at that point the configuration is just wrong.
         , package text ?
           builder CabalFlags ? notStage0 ? intLib == integerSimple ?
-          pure [ "+integer-simple", "-bytestring-builder"]
+          pure [ "+integer-simple", "-bytestring-builder"] ]
 
 
-        -------------------------------- runGhc --------------------------------
-        , package runGhc ?
-          builder Ghc ? input "//Main.hs" ?
-          (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
+-- | RTS-specific command line arguments.
+rtsPackageArgs :: Args
+rtsPackageArgs = package rts ? do
+    projectVersion <- getSetting ProjectVersion
+    hostPlatform   <- getSetting HostPlatform
+    hostArch       <- getSetting HostArch
+    hostOs         <- getSetting HostOs
+    hostVendor     <- getSetting HostVendor
+    buildPlatform  <- getSetting BuildPlatform
+    buildArch      <- getSetting BuildArch
+    buildOs        <- getSetting BuildOs
+    buildVendor    <- getSetting BuildVendor
+    targetPlatform <- getSetting TargetPlatform
+    targetArch     <- getSetting TargetArch
+    targetOs       <- getSetting TargetOs
+    targetVendor   <- getSetting TargetVendor
+    ghcUnreg       <- expr $ yesNo <$> flag GhcUnregisterised
+    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode
+    rtsWays        <- getRtsWays
+    way            <- getWay
+    path           <- getBuildPath
+    top            <- expr topDirectory
+    libffiName     <- expr libffiLibraryName
+    ffiIncludeDir  <- getSetting FfiIncludeDir
+    ffiLibraryDir  <- getSetting FfiLibDir
+    ghclibDir      <- expr installGhcLibDir
+    destDir        <- expr getDestDir
+    let cArgs = mconcat
+          [ arg "-Irts"
+          , rtsWarnings
+          , arg $ "-I" ++ path
+          , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
+          , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
+          -- Set the namespace for the rts fs functions
+          , arg $ "-DFS_NAMESPACE=rts"
+          , arg $ "-DCOMPILING_RTS"
+          -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
+          -- requires that functions are inlined to work as expected. Inlining
+          -- only happens for optimised builds. Otherwise we can assume that
+          -- there is a non-inlined variant to use instead. But RTS does not
+          -- provide non-inlined alternatives and hence needs the function to
+          -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
+          , arg "-O2"
+          , arg "-fomit-frame-pointer"
+          , arg "-g"
 
 
-        ---------------------------------- rts ---------------------------------
-        , package rts ?
-          builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" ]
+          , Debug     `wayUnit` way          ? pure [ "-DDEBUG"
+                                                    , "-fno-omit-frame-pointer"
+                                                    , "-g"
+                                                    , "-O0" ]
+          , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY"
+          , Profiling `wayUnit` way          ? arg "-DPROFILING"
+          , Threaded  `wayUnit` way          ? arg "-DTHREADED_RTS"
+
+          , inputs ["//RtsMessages.c", "//Trace.c"] ?
+            arg ("-DProjectVersion=" ++ show projectVersion)
+
+          , input "//RtsUtils.c" ? pure
+            [ "-DProjectVersion="            ++ show projectVersion
+            , "-DHostPlatform="              ++ show hostPlatform
+            , "-DHostArch="                  ++ show hostArch
+            , "-DHostOS="                    ++ show hostOs
+            , "-DHostVendor="                ++ show hostVendor
+            , "-DBuildPlatform="             ++ show buildPlatform
+            , "-DBuildArch="                 ++ show buildArch
+            , "-DBuildOS="                   ++ show buildOs
+            , "-DBuildVendor="               ++ show buildVendor
+            , "-DTargetPlatform="            ++ show targetPlatform
+            , "-DTargetArch="                ++ show targetArch
+            , "-DTargetOS="                  ++ show targetOs
+            , "-DTargetVendor="              ++ show targetVendor
+            , "-DGhcUnregisterised="         ++ show ghcUnreg
+            , "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]
+
+          -- We're after pur performance here. So make sure fast math and
+          -- vectorization is enabled.
+          , input "//xxhash.c" ? pure
+            [ "-O3"
+            , "-ffast-math"
+            , "-ftree-vectorize" ]
+
+            , inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops"
+
+            , speedHack ?
+              inputs [ "//Evac.c", "//Evac_thr.c"
+                     , "//Scav.c", "//Scav_thr.c"
+                     , "//Compact.c", "//GC.c" ] ? arg "-fno-PIC"
+            -- @-static@ is necessary for these bits, as otherwise the NCG
+            -- generates dynamic references.
+            , speedHack ?
+              inputs [ "//Updates.c", "//StgMiscClosures.c"
+                     , "//PrimOps.c", "//Apply.c"
+                     , "//AutoApply.c" ] ? pure ["-fno-PIC", "-static"]
+
+            -- inlining warnings happen in Compact
+            , inputs ["//Compact.c"] ? arg "-Wno-inline"
+
+            -- emits warnings about call-clobbered registers on x86_64
+            , inputs [ "//RetainerProfile.c", "//StgCRun.c"
+                     , "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w"
+            -- The above warning suppression flags are a temporary kludge.
+            -- While working on this module you are encouraged to remove it and fix
+            -- any warnings in the module. See:
+            -- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+
+            , (not <$> flag GccIsClang) ?
+              inputs ["//Compact.c"] ? arg "-finline-limit=2500"
+
+            , input "//RetainerProfile.c" ? flag GccIsClang ?
+              arg "-Wno-incompatible-pointer-types"
+            , windowsHost ? arg ("-DWINVER=" ++ windowsVersion)
+
+            -- libffi's ffi.h triggers various warnings
+            , inputs [ "//Interpreter.c", "//Storage.c", "//Adjustor.c" ] ?
+              arg "-Wno-strict-prototypes"
+            , inputs ["//Interpreter.c", "//Adjustor.c", "//sm/Storage.c"] ?
+              anyTargetArch ["powerpc"] ? arg "-Wno-undef" ]
+
+    mconcat
+        [ builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling"
+        , builder (Cc FindCDependencies) ? cArgs
+        , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
+        , builder Ghc ? arg "-Irts"
+
+          , builder HsCpp ? pure
+          [ "-DTOP="             ++ show top
+          , "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
+          , "-DFFI_LIB_DIR="     ++ show ffiLibraryDir
+          , "-DFFI_LIB="         ++ show libffiName ]
+
+        , builder HsCpp ?
+          input "//package.conf.in" ?
+          output "//package.conf.install.raw" ?
+          pure [ "-DINSTALLING"
+               , "-DLIB_DIR=\"" ++ destDir ++ ghclibDir ++ "\""
+               , "-DINCLUDE_DIR=\"" ++ destDir ++ ghclibDir -/- "include\"" ]
+
+        , builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]
+
+-- Compile various performance-critical pieces *without* -fPIC -dynamic
+-- even when building a shared library.  If we don't do this, then the
+-- GC runs about 50% slower on x86 due to the overheads of PIC.  The
+-- cost of doing this is a little runtime linking and less sharing, but
+-- not much.
+--
+-- On x86_64 this doesn't work, because all objects in a shared library
+-- must be compiled with -fPIC (since the 32-bit relocations generated
+-- by the default small memory can't be resolved at runtime).  So we
+-- only do this on i386.
+--
+-- This apparently doesn't work on OS X (Darwin) nor on Solaris.
+-- On Darwin we get errors of the form
+--
+--  ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast
+--      from rts/dist/build/Apply.dyn_o not allowed in slidable image
+--
+-- and lots of these warnings:
+--
+--  ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image
+--      from loading in dyld shared cache
+--
+-- On Solaris we get errors like:
+--
+-- Text relocation remains                         referenced
+--     against symbol                  offset      in file
+-- .rodata (section)                   0x11        rts/dist/build/Apply.dyn_o
+--   ...
+-- ld: fatal: relocations remain against allocatable but non-writable sections
+-- collect2: ld returned 1 exit status
+speedHack :: Action Bool
+speedHack = do
+    i386   <- anyTargetArch ["i386"]
+    goodOS <- not <$> anyTargetOs ["darwin", "solaris2"]
+    return $ i386 && goodOS
+
+-- See @rts/ghc.mk@.
+rtsWarnings :: Args
+rtsWarnings = mconcat
+    [ arg "-Wall"
+    , arg "-Wextra"
+    , arg "-Wstrict-prototypes"
+    , arg "-Wmissing-prototypes"
+    , arg "-Wmissing-declarations"
+    , arg "-Winline"
+    , arg "-Waggregate-return"
+    , arg "-Wpointer-arith"
+    , arg "-Wmissing-noreturn"
+    , arg "-Wnested-externs"
+    , arg "-Wredundant-decls"
+    , arg "-Wundef"
+    , arg "-fno-strict-aliasing" ]
+
+-- These numbers can be found at:
+-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
+-- If we're compiling on windows, enforce that we only support Vista SP1+
+-- Adding this here means it doesn't have to be done in individual .c files
+-- and also centralizes the versioning.
+-- | Minimum supported Windows version.
+windowsVersion :: String
+windowsVersion = "0x06000100"
diff --git a/src/Settings/Packages/Base.hs b/src/Settings/Packages/Base.hs
deleted file mode 100644 (file)
index 2e0ced4..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-module Settings.Packages.Base (basePackageArgs) where
-
-import Expression
-import Settings
-
-basePackageArgs :: Args
-basePackageArgs = package base ? do
-    integerLibraryName <- pkgName <$> getIntegerPackage
-    mconcat [ builder GhcCabal ? arg ("--flags=" ++ integerLibraryName)
-            -- This fixes the 'unknown symbol stat' issue.
-            -- See: https://github.com/snowleopard/hadrian/issues/259.
-            , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]
diff --git a/src/Settings/Packages/Cabal.hs b/src/Settings/Packages/Cabal.hs
deleted file mode 100644 (file)
index c01be4b..0000000
+++ /dev/null
@@ -1,10 +0,0 @@
-module Settings.Packages.Cabal where
-
-import Expression
-
-cabalPackageArgs :: Args
-cabalPackageArgs = package cabal ?
-    -- Cabal is a rather large library and quite slow to compile. Moreover, we
-    -- build it for stage0 only so we can link ghc-pkg against it, so there is
-    -- little reason to spend the effort to optimize it.
-    stage0 ? builder Ghc ? arg "-O0"
diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs
deleted file mode 100644 (file)
index 77692fa..0000000
+++ /dev/null
@@ -1,45 +0,0 @@
-module Settings.Packages.Compiler (compilerPackageArgs) where
-
-import Base
-import Expression
-import Flavour
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-
-compilerPackageArgs :: Args
-compilerPackageArgs = package compiler ? do
-    stage   <- getStage
-    rtsWays <- getRtsWays
-    path    <- getBuildPath
-    mconcat [ builder Alex ? arg "--latin1"
-
-            , builder (Ghc CompileHs) ? mconcat
-              [ inputs ["//GHC.hs", "//GhcMake.hs"] ? arg "-fprof-auto"
-              , input "//Parser.hs" ?
-                pure ["-O0", "-fno-ignore-interface-pragmas", "-fcmm-sink" ] ]
-
-            , builder GhcCabal ? mconcat
-              [ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1)
-              , arg "--disable-library-for-ghci"
-              , anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
-              , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
-              , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP"
-              , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
-              , (threaded `elem` rtsWays) ?
-                notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
-              , ghcWithNativeCodeGen ? arg "--flags=ncg"
-              , ghcWithInterpreter ?
-                notStage0 ? arg "--flags=ghci"
-              , flag CrossCompiling ? arg "-f-terminfo"
-              , ghcWithInterpreter ?
-                ghcEnableTablesNextToCode ?
-                notM (flag GhcUnregisterised) ?
-                notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
-              , ghcWithInterpreter ?
-                ghciWithDebugger <$> flavour ?
-                notStage0 ? arg "--ghc-option=-DDEBUGGER"
-              , ghcProfiled <$> flavour ?
-                notStage0 ? arg "--ghc-pkg-option=--force" ]
-
-            , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
diff --git a/src/Settings/Packages/Ghc.hs b/src/Settings/Packages/Ghc.hs
deleted file mode 100644 (file)
index d7b1d78..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-module Settings.Packages.Ghc (ghcPackageArgs) where
-
-import Expression
-import Oracles.Setting
-import Oracles.Flag (crossCompiling)
-
-ghcPackageArgs :: Args
-ghcPackageArgs = package ghc ? do
-    stage <- getStage
-    path  <- expr $ buildPath (vanillaContext stage compiler)
-    mconcat [ builder Ghc      ? arg ("-I" ++ path)
-            , builder GhcCabal ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci"
-            , builder GhcCabal ? crossCompiling ? arg "-f-terminfo" ]
diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs
deleted file mode 100644 (file)
index 70f2449..0000000
+++ /dev/null
@@ -1,32 +0,0 @@
-module Settings.Packages.GhcCabal (ghcCabalPackageArgs) where
-
-import Hadrian.Haskell.Cabal
-
-import Base
-import Expression
-import Utilities
-
-ghcCabalPackageArgs :: Args
-ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do
-    cabalDeps <- expr $ stage1Dependencies cabal
-    let bootDeps = cabalDeps \\ [integerGmp, integerSimple, mtl, parsec, text]
-    cabalVersion <- expr $ pkgVersion (unsafePkgCabalFile cabal) -- TODO: improve
-    mconcat
-        [ pure [ "-package " ++ pkgName pkg | pkg <- bootDeps ]
-        , arg "--make"
-        , arg "-j"
-        , pure ["-Wall", "-fno-warn-unused-imports", "-fno-warn-warnings-deprecations"]
-        , arg ("-DCABAL_VERSION=" ++ replace "." "," cabalVersion)
-        , arg "-DCABAL_PARSEC"
-        , arg "-DBOOTSTRAPPING"
-        , arg "-DMIN_VERSION_binary_0_8_0"
-        , arg "libraries/text/cbits/cbits.c"
-        , arg "-ilibraries/Cabal/Cabal"
-        , arg "-ilibraries/binary/src"
-        , arg "-ilibraries/filepath"
-        , arg "-ilibraries/hpc"
-        , arg "-ilibraries/mtl"
-        , arg "-ilibraries/text"
-        , arg "-Ilibraries/text/include"
-        , arg "-ilibraries/parsec/src" ]
-
diff --git a/src/Settings/Packages/GhcPkg.hs b/src/Settings/Packages/GhcPkg.hs
deleted file mode 100644 (file)
index a13a9da..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-module Settings.Packages.GhcPkg (ghcPkgPackageArgs) where
-
-import Expression
-import Oracles.Flag (crossCompiling)
-
-ghcPkgPackageArgs :: Args
-ghcPkgPackageArgs = package ghcPkg ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo"
diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs
deleted file mode 100644 (file)
index aed8f2f..0000000
+++ /dev/null
@@ -1,12 +0,0 @@
-module Settings.Packages.GhcPrim (ghcPrimPackageArgs) where
-
-import Oracles.Flag
-import Expression
-
-ghcPrimPackageArgs :: Args
-ghcPrimPackageArgs = package ghcPrim ? mconcat
-    [ builder GhcCabal ? arg "--flag=include-ghc-prim"
-
-    , builder (Cc CompileC)     ?
-      (not <$> flag GccIsClang) ?
-      input "//cbits/atomic.c"  ? arg "-Wno-sync-nand" ]
diff --git a/src/Settings/Packages/Ghci.hs b/src/Settings/Packages/Ghci.hs
deleted file mode 100644 (file)
index 47e7d38..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-module Settings.Packages.Ghci (ghciPackageArgs) where
-
-import Expression
-
-ghciPackageArgs :: Args
-ghciPackageArgs = package ghci ? notStage0 ? builder GhcCabal ? arg "--flags=ghci"
diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs
deleted file mode 100644 (file)
index c8d667e..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-module Settings.Packages.Haddock (haddockPackageArgs) where
-
-import Expression
-
-haddockPackageArgs :: Args
-haddockPackageArgs = package haddock ?
-    builder GhcCabal ? pure ["--flag", "in-ghc-tree"]
diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs
deleted file mode 100644 (file)
index 7c2b5f6..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where
-
-import Base
-import Expression
-import Oracles.Setting
-import Rules.Gmp
-
--- TODO: Is this needed?
--- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
--- libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
--- endif
-integerGmpPackageArgs :: Args
-integerGmpPackageArgs = package integerGmp ? do
-    path <- expr gmpBuildPath
-    let includeGmp = "-I" ++ path -/- "include"
-    gmpIncludeDir <- getSetting GmpIncludeDir
-    gmpLibDir     <- getSetting GmpLibDir
-    mconcat [ builder Cc ? arg includeGmp
-
-            , builder GhcCabal ? mconcat
-              [ (null gmpIncludeDir && null gmpLibDir) ?
-                arg "--configure-option=--with-intree-gmp"
-              , arg ("--configure-option=CFLAGS=" ++ includeGmp)
-              , arg ("--gcc-options="             ++ includeGmp) ] ]
diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs
deleted file mode 100644 (file)
index 67ea3e7..0000000
+++ /dev/null
@@ -1,236 +0,0 @@
-module Settings.Packages.Rts (
-    rtsContext, rtsBuildPath, rtsConfIn, rtsPackageArgs, rtsLibffiLibrary
-    ) where
-
-import Base
-import Expression
-import GHC.Packages
-import Oracles.Flag
-import Oracles.Setting
-import Settings
-
--- | RTS is considered a Stage1 package. This determines RTS build directory.
-rtsContext :: Context
-rtsContext = vanillaContext Stage1 rts
-
--- | Path to the RTS build directory.
-rtsBuildPath :: Action FilePath
-rtsBuildPath = buildPath rtsContext
-
--- | Path to RTS package configuration file, to be processed by HsCpp.
-rtsConfIn :: FilePath
-rtsConfIn = pkgPath rts -/- "package.conf.in"
-
--- These numbers can be found at:
--- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
--- If we're compiling on windows, enforce that we only support Vista SP1+
--- Adding this here means it doesn't have to be done in individual .c files
--- and also centralizes the versioning.
--- | Minimum supported Windows version.
-windowsVersion :: String
-windowsVersion = "0x06000100"
-
-libffiLibraryName :: Action FilePath
-libffiLibraryName = do
-    useSystemFfi <- flag UseSystemFfi
-    windows      <- windowsHost
-    return $ case (useSystemFfi, windows) of
-        (True , False) -> "ffi"
-        (False, False) -> "Cffi"
-        (_    , True ) -> "Cffi-6"
-
-rtsLibffiLibrary :: Way -> Action FilePath
-rtsLibffiLibrary way = do
-    name    <- libffiLibraryName
-    suf     <- libsuf way
-    rtsPath <- rtsBuildPath
-    return $ rtsPath -/- "lib" ++ name ++ suf
-
--- Compile various performance-critical pieces *without* -fPIC -dynamic
--- even when building a shared library.  If we don't do this, then the
--- GC runs about 50% slower on x86 due to the overheads of PIC.  The
--- cost of doing this is a little runtime linking and less sharing, but
--- not much.
---
--- On x86_64 this doesn't work, because all objects in a shared library
--- must be compiled with -fPIC (since the 32-bit relocations generated
--- by the default small memory can't be resolved at runtime).  So we
--- only do this on i386.
---
--- This apparently doesn't work on OS X (Darwin) nor on Solaris.
--- On Darwin we get errors of the form
---
---  ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast
---      from rts/dist/build/Apply.dyn_o not allowed in slidable image
---
--- and lots of these warnings:
---
---  ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image
---      from loading in dyld shared cache
---
--- On Solaris we get errors like:
---
--- Text relocation remains                         referenced
---     against symbol                  offset      in file
--- .rodata (section)                   0x11        rts/dist/build/Apply.dyn_o
---   ...
--- ld: fatal: relocations remain against allocatable but non-writable sections
--- collect2: ld returned 1 exit status
-speedHack :: Action Bool
-speedHack = do
-    i386   <- anyTargetArch ["i386"]
-    goodOS <- not <$> anyTargetOs ["darwin", "solaris2"]
-    return $ i386 && goodOS
-
-rtsPackageArgs :: Args
-rtsPackageArgs = package rts ? do
-    projectVersion <- getSetting ProjectVersion
-    hostPlatform   <- getSetting HostPlatform
-    hostArch       <- getSetting HostArch
-    hostOs         <- getSetting HostOs
-    hostVendor     <- getSetting HostVendor
-    buildPlatform  <- getSetting BuildPlatform
-    buildArch      <- getSetting BuildArch
-    buildOs        <- getSetting BuildOs
-    buildVendor    <- getSetting BuildVendor
-    targetPlatform <- getSetting TargetPlatform
-    targetArch     <- getSetting TargetArch
-    targetOs       <- getSetting TargetOs
-    targetVendor   <- getSetting TargetVendor
-    ghcUnreg       <- expr $ yesNo <$> flag GhcUnregisterised
-    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode
-    way            <- getWay
-    path           <- getBuildPath
-    top            <- expr topDirectory
-    libffiName     <- expr libffiLibraryName
-    ffiIncludeDir  <- getSetting FfiIncludeDir
-    ffiLibraryDir  <- getSetting FfiLibDir
-    ghclibDir      <- expr installGhcLibDir
-    destDir        <- expr getDestDir
-    let cArgs = mconcat
-          [ arg "-Irts"
-          , rtsWarnings
-          , arg $ "-I" ++ path
-          , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
-          , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
-          -- Set the namespace for the rts fs functions
-          , arg $ "-DFS_NAMESPACE=rts"
-          , arg $ "-DCOMPILING_RTS"
-          -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
-          -- requires that functions are inlined to work as expected. Inlining
-          -- only happens for optimised builds. Otherwise we can assume that
-          -- there is a non-inlined variant to use instead. But RTS does not
-          -- provide non-inlined alternatives and hence needs the function to
-          -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
-          , arg "-O2"
-          , arg "-fomit-frame-pointer"
-          , arg "-g"
-
-          , Debug     `wayUnit` way          ? pure [ "-DDEBUG"
-                                                    , "-fno-omit-frame-pointer"
-                                                    , "-g"
-                                                    , "-O0" ]
-          , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY"
-          , Profiling `wayUnit` way          ? arg "-DPROFILING"
-          , Threaded  `wayUnit` way          ? arg "-DTHREADED_RTS"
-
-          , inputs ["//RtsMessages.c", "//Trace.c"] ?
-            arg ("-DProjectVersion=" ++ show projectVersion)
-
-          , input "//RtsUtils.c" ? pure
-            [ "-DProjectVersion="            ++ show projectVersion
-            , "-DHostPlatform="              ++ show hostPlatform
-            , "-DHostArch="                  ++ show hostArch
-            , "-DHostOS="                    ++ show hostOs
-            , "-DHostVendor="                ++ show hostVendor
-            , "-DBuildPlatform="             ++ show buildPlatform
-            , "-DBuildArch="                 ++ show buildArch
-            , "-DBuildOS="                   ++ show buildOs
-            , "-DBuildVendor="               ++ show buildVendor
-            , "-DTargetPlatform="            ++ show targetPlatform
-            , "-DTargetArch="                ++ show targetArch
-            , "-DTargetOS="                  ++ show targetOs
-            , "-DTargetVendor="              ++ show targetVendor
-            , "-DGhcUnregisterised="         ++ show ghcUnreg
-            , "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]
-
-          -- We're after pur performance here. So make sure fast math and
-          -- vectorization is enabled.
-          , input "//xxhash.c" ? pure
-            [ "-O3"
-            , "-ffast-math"
-            , "-ftree-vectorize" ]
-
-            , inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops"
-
-            , speedHack ?
-              inputs [ "//Evac.c", "//Evac_thr.c"
-                     , "//Scav.c", "//Scav_thr.c"
-                     , "//Compact.c", "//GC.c" ] ? arg "-fno-PIC"
-            -- -static is also necessary for these bits, otherwise the NCG
-            -- generates dynamic references:
-            , speedHack ?
-              inputs [ "//Updates.c", "//StgMiscClosures.c"
-                     , "//PrimOps.c", "//Apply.c"
-                     , "//AutoApply.c" ] ? pure ["-fno-PIC", "-static"]
-
-            -- inlining warnings happen in Compact
-            , inputs ["//Compact.c"] ? arg "-Wno-inline"
-
-            -- emits warnings about call-clobbered registers on x86_64
-            , inputs [ "//RetainerProfile.c", "//StgCRun.c"
-                     , "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w"
-            -- The above warning suppression flags are a temporary kludge.
-            -- While working on this module you are encouraged to remove it and fix
-            -- any warnings in the module. See:
-            -- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
-
-            , (not <$> flag GccIsClang) ?
-              inputs ["//Compact.c"] ? arg "-finline-limit=2500"
-
-            , input "//RetainerProfile.c" ? flag GccIsClang ?
-              arg "-Wno-incompatible-pointer-types"
-            , windowsHost ? arg ("-DWINVER=" ++ windowsVersion)
-
-            -- libffi's ffi.h triggers various warnings
-            , inputs [ "//Interpreter.c", "//Storage.c", "//Adjustor.c" ] ?
-              arg "-Wno-strict-prototypes"
-            , inputs ["//Interpreter.c", "//Adjustor.c", "//sm/Storage.c"] ?
-              anyTargetArch ["powerpc"] ? arg "-Wno-undef" ]
-
-    mconcat
-        [ builder (Cc FindCDependencies) ? cArgs
-        , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
-        , builder Ghc ? arg "-Irts"
-
-          , builder HsCpp ? pure
-          [ "-DTOP="             ++ show top
-          , "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
-          , "-DFFI_LIB_DIR="     ++ show ffiLibraryDir
-          , "-DFFI_LIB="         ++ show libffiName ]
-
-        , builder HsCpp ?
-          input "//package.conf.in" ?
-          output "//package.conf.install.raw" ?
-          pure [ "-DINSTALLING"
-               , "-DLIB_DIR=\"" ++ destDir ++ ghclibDir ++ "\""
-               , "-DINCLUDE_DIR=\"" ++ destDir ++ ghclibDir -/- "include\"" ]
-
-        , builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]
-
--- See @rts/ghc.mk@.
-rtsWarnings :: Args
-rtsWarnings = mconcat
-    [ arg "-Wall"
-    , arg "-Wextra"
-    , arg "-Wstrict-prototypes"
-    , arg "-Wmissing-prototypes"
-    , arg "-Wmissing-declarations"
-    , arg "-Winline"
-    , arg "-Waggregate-return"
-    , arg "-Wpointer-arith"
-    , arg "-Wmissing-noreturn"
-    , arg "-Wnested-externs"
-    , arg "-Wredundant-decls"
-    , arg "-Wundef"
-    , arg "-fno-strict-aliasing" ]
diff --git a/src/Settings/Packages/RunGhc.hs b/src/Settings/Packages/RunGhc.hs
deleted file mode 100644 (file)
index 03a19c8..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-module Settings.Packages.RunGhc (runGhcPackageArgs) where
-
-import Oracles.Setting
-import Expression
-
-runGhcPackageArgs :: Args
-runGhcPackageArgs = package runGhc ? builder Ghc ? input "//Main.hs" ? do
-    version <- getSetting ProjectVersion
-    pure ["-cpp", "-DVERSION=" ++ show version]