From 235809092b65d1631735b70e9ce9dd2e9ebab47d Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Fri, 15 Jun 2018 01:15:47 +0100 Subject: [PATCH] Refactor package-specific settings (#622) * Minor clean up * Track rts.cabal * Move all package-specific settings to Settings.Packages, plus another revision, see #540 * Drop Rules.PackageData --- hadrian.cabal | 4 +- src/Base.hs | 7 +- src/Context.hs | 3 +- src/Context/{Paths.hs => Path.hs} | 14 +- src/GHC.hs | 28 +++- src/Rules.hs | 15 +- src/Rules/Configure.hs | 9 +- src/Rules/Generate.hs | 3 +- src/Rules/Gmp.hs | 2 +- src/Rules/Libffi.hs | 21 ++- src/Rules/PackageData.hs | 33 ---- src/Rules/Program.hs | 1 - src/Rules/Register.hs | 51 +++--- src/Settings/Builders/Configure.hs | 2 +- src/Settings/Builders/Make.hs | 1 - src/Settings/Default.hs | 6 +- src/Settings/Packages.hs | 222 ++++++++++++++++++++++++-- src/Settings/Packages/Base.hs | 12 -- src/Settings/Packages/Cabal.hs | 10 -- src/Settings/Packages/Compiler.hs | 45 ------ src/Settings/Packages/Ghc.hs | 13 -- src/Settings/Packages/GhcCabal.hs | 32 ---- src/Settings/Packages/GhcPkg.hs | 7 - src/Settings/Packages/GhcPrim.hs | 12 -- src/Settings/Packages/Ghci.hs | 6 - src/Settings/Packages/Haddock.hs | 7 - src/Settings/Packages/IntegerGmp.hs | 24 --- src/Settings/Packages/Rts.hs | 236 ---------------------------- src/Settings/Packages/RunGhc.hs | 9 -- 29 files changed, 307 insertions(+), 528 deletions(-) rename src/Context/{Paths.hs => Path.hs} (68%) delete mode 100644 src/Rules/PackageData.hs delete mode 100644 src/Settings/Packages/Base.hs delete mode 100644 src/Settings/Packages/Cabal.hs delete mode 100644 src/Settings/Packages/Compiler.hs delete mode 100644 src/Settings/Packages/Ghc.hs delete mode 100644 src/Settings/Packages/GhcCabal.hs delete mode 100644 src/Settings/Packages/GhcPkg.hs delete mode 100644 src/Settings/Packages/GhcPrim.hs delete mode 100644 src/Settings/Packages/Ghci.hs delete mode 100644 src/Settings/Packages/Haddock.hs delete mode 100644 src/Settings/Packages/IntegerGmp.hs delete mode 100644 src/Settings/Packages/Rts.hs delete mode 100644 src/Settings/Packages/RunGhc.hs diff --git a/hadrian.cabal b/hadrian.cabal index ef90c749c1..9c8e13487c 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -22,7 +22,7 @@ executable hadrian , Builder , CommandLine , Context - , Context.Paths + , Context.Path , Context.Type , Environment , Expression @@ -55,7 +55,6 @@ executable hadrian , Rules.Clean , Rules.Compile , Rules.Configure - , Rules.PackageData , Rules.Dependencies , Rules.Documentation , Rules.Generate @@ -94,7 +93,6 @@ executable hadrian , Settings.Flavours.QuickCross , Settings.Flavours.Quickest , Settings.Packages - , Settings.Packages.Rts , Settings.Warnings , Stage , Target diff --git a/src/Base.hs b/src/Base.hs index 430078dd2d..32fb979a9f 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -20,12 +20,11 @@ module Base ( -- * Files configH, ghcVersionH, + -- * 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 diff --git a/src/Context.hs b/src/Context.hs index 0694eb1508..914212547f 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -13,7 +13,7 @@ module Context ( ) where import Base -import Context.Paths +import Context.Path 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" +-- TODO: Add a @Rules FilePath@ alternative. -- | Path to the @setup-config@ of a given 'Context'. pkgSetupConfigFile :: Context -> Action FilePath pkgSetupConfigFile context = do diff --git a/src/Context/Paths.hs b/src/Context/Path.hs similarity index 68% rename from src/Context/Paths.hs rename to src/Context/Path.hs index b023c4d3b5..4bc9d9be34 100644 --- a/src/Context/Paths.hs +++ b/src/Context/Path.hs @@ -1,17 +1,18 @@ -module Context.Paths where +module Context.Path where 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 --- | The path to the current stage +-- | The build path of the current 'Stage'. 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 @@ -19,10 +20,13 @@ getStagePath = expr . stagePath =<< getContext 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) +-- | 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 @@ -34,6 +38,6 @@ buildDir context = contextDir context -/- "build" 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 diff --git a/src/GHC.hs b/src/GHC.hs index d286ccbb7e..9a160ce2f5 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -15,7 +15,8 @@ module GHC ( programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, -- * Miscellaneous - programPath, buildDll0 + programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext, + libffiBuildPath, libffiLibraryName ) where import Base @@ -174,3 +175,28 @@ buildDll0 :: Context -> Action Bool 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" diff --git a/src/Rules.hs b/src/Rules.hs index 7533a2757c..2bf41916b6 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -17,7 +17,6 @@ import qualified Rules.Generate 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 @@ -108,15 +107,15 @@ packageRules = do 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 - [ Rules.PackageData.buildPackageData + [ Rules.Register.configurePackage , Rules.Dependencies.buildPackageDependencies readPackageDb , Rules.Documentation.buildPackageDocumentation , Rules.Generate.generatePackageCode ] diff --git a/src/Rules/Configure.hs b/src/Rules/Configure.hs index 050d7f3de8..8cdc07db97 100644 --- a/src/Rules/Configure.hs +++ b/src/Rules/Configure.hs @@ -10,10 +10,15 @@ import GHC 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 - -- 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) $ diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index e26e811fe8..c6be43ae30 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -6,14 +6,13 @@ module Rules.Generate ( 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 Settings.Packages.Rts import Target import Utilities diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 9b45c0ebd4..f1f0ee95a8 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -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. - setupConfig <- contextPath gmpContext <&> (-/- "setup-config") + setupConfig <- pkgSetupConfigFile gmpContext need [setupConfig] -- TODO: Get rid of hard-coded @gmp@. diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index a51e75886f..834cbc6d6f 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -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 Settings.Packages.Rts 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" +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@)") --- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs) -- 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 index 96e996032e..0000000000 --- a/src/Rules/PackageData.hs +++ /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 diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 7b137f0d4e..fb7179a4c2 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -10,7 +10,6 @@ import GHC import Oracles.Flag import Oracles.ModuleFiles import Settings -import Settings.Packages.Rts import Target import Utilities diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index b66f085172..677ee9fc35 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -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 @@ -7,29 +10,36 @@ import Settings 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.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 - 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 -/- 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. + -- Register a package. 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 - -- 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 @@ -71,8 +80,8 @@ buildConf _ context@Context {..} _conf = do 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 @@ -94,9 +103,3 @@ copyConf rs context@Context {..} conf = do 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 diff --git a/src/Settings/Builders/Configure.hs b/src/Settings/Builders/Configure.hs index 93225b5405..37442d448d 100644 --- a/src/Settings/Builders/Configure.hs +++ b/src/Settings/Builders/Configure.hs @@ -1,7 +1,7 @@ module Settings.Builders.Configure (configureBuilderArgs) where +import GHC import Rules.Gmp -import Rules.Libffi import Settings.Builders.Common configureBuilderArgs :: Args diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index 6f8768de1f..f366b83660 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -3,7 +3,6 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where import GHC import Oracles.Setting import Rules.Gmp -import Rules.Libffi import Settings.Builders.Common makeBuilderArgs :: Args diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 35bc1ac28b..f955139d27 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -26,7 +26,6 @@ import Settings.Builders.Make import Settings.Builders.RunTest import Settings.Builders.Xelatex import Settings.Packages -import Settings.Packages.Rts import Settings.Warnings import {-# SOURCE #-} Builder @@ -152,7 +151,4 @@ defaultBuilderArgs = mconcat -- | All 'Package'-dependent command line arguments. defaultPackageArgs :: Args -defaultPackageArgs = mconcat - [ packageArgs - , rtsPackageArgs - , warningArgs ] +defaultPackageArgs = mconcat [ packageArgs, warningArgs ] diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index b221031100..6a23bb7ab3 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -2,19 +2,19 @@ module Settings.Packages (packageArgs) where import Expression import Flavour -import GHC.Packages +import GHC 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 - rtsWays <- getRtsWays path <- getBuildPath + rtsWays <- getRtsWays compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler) gmpBuildPath <- expr gmpBuildPath @@ -139,6 +139,14 @@ packageArgs = do 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@ @@ -150,13 +158,205 @@ packageArgs = do -- 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 index 2e0ced4c26..0000000000 --- a/src/Settings/Packages/Base.hs +++ /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 index c01be4b3ed..0000000000 --- a/src/Settings/Packages/Cabal.hs +++ /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 index 77692fae7c..0000000000 --- a/src/Settings/Packages/Compiler.hs +++ /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 index d7b1d78ddd..0000000000 --- a/src/Settings/Packages/Ghc.hs +++ /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 index 70f24490f0..0000000000 --- a/src/Settings/Packages/GhcCabal.hs +++ /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 index a13a9dab7e..0000000000 --- a/src/Settings/Packages/GhcPkg.hs +++ /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 index aed8f2ff73..0000000000 --- a/src/Settings/Packages/GhcPrim.hs +++ /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 index 47e7d38deb..0000000000 --- a/src/Settings/Packages/Ghci.hs +++ /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 index c8d667ecb4..0000000000 --- a/src/Settings/Packages/Haddock.hs +++ /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 index 7c2b5f635b..0000000000 --- a/src/Settings/Packages/IntegerGmp.hs +++ /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 index 67ea3e76b6..0000000000 --- a/src/Settings/Packages/Rts.hs +++ /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 index 03a19c8373..0000000000 --- a/src/Settings/Packages/RunGhc.hs +++ /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] -- GitLab