diff options
Diffstat (limited to 'hadrian/src/Settings')
28 files changed, 1821 insertions, 0 deletions
diff --git a/hadrian/src/Settings/Builders/Alex.hs b/hadrian/src/Settings/Builders/Alex.hs new file mode 100644 index 0000000000..e0ef1367f7 --- /dev/null +++ b/hadrian/src/Settings/Builders/Alex.hs @@ -0,0 +1,8 @@ +module Settings.Builders.Alex (alexBuilderArgs) where + +import Settings.Builders.Common + +alexBuilderArgs :: Args +alexBuilderArgs = builder Alex ? mconcat [ arg "-g" + , arg =<< getInput + , arg "-o", arg =<< getOutput ] diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs new file mode 100644 index 0000000000..f33e9b458c --- /dev/null +++ b/hadrian/src/Settings/Builders/Cabal.hs @@ -0,0 +1,153 @@ +module Settings.Builders.Cabal (cabalBuilderArgs) where + +import Hadrian.Builder (getBuilderPath, needBuilder) +import Hadrian.Haskell.Cabal + +import Builder +import Context +import Flavour +import Packages +import Settings.Builders.Common + +cabalBuilderArgs :: Args +cabalBuilderArgs = builder (Cabal Setup) ? do + verbosity <- expr getVerbosity + top <- expr topDirectory + path <- getContextPath + stage <- getStage + mconcat [ arg "configure" + -- Don't strip libraries when cross compiling. + -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, + -- and if it's @:@ disable stripping as well. As it is now, I believe + -- we might have issues with stripping on Windows, as I can't see a + -- consumer of 'stripCmdPath'. + -- TODO: See https://github.com/snowleopard/hadrian/issues/549. + , flag CrossCompiling ? pure [ "--disable-executable-stripping" + , "--disable-library-stripping" ] + , arg "--cabal-file" + , arg =<< pkgCabalFile <$> getPackage + , arg "--distdir" + , arg $ top -/- path + , arg "--ipid" + , arg "$pkg-$version" + , arg "--prefix" + , arg "${pkgroot}/.." + , withStaged $ Ghc CompileHs + , withStaged (GhcPkg Update) + , withBuilderArgs (GhcPkg Update stage) + , bootPackageDatabaseArgs + , libraryArgs + , configureArgs + , bootPackageConstraints + , withStaged $ Cc CompileC + , notStage0 ? with (Ld stage) + , withStaged (Ar Pack) + , with Alex + , with Happy + , verbosity < Chatty ? + pure [ "-v0", "--configure-option=--quiet" + , "--configure-option=--disable-option-checking" ] ] + +-- TODO: Isn't vanilla always built? If yes, some conditions are redundant. +-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci? +-- TODO: should `elem` be `wayUnit`? +-- This approach still doesn't work. Previously libraries were build only in the +-- Default flavours and not using context. +libraryArgs :: Args +libraryArgs = do + flavourWays <- getLibraryWays + contextWay <- getWay + withGhci <- expr ghcWithInterpreter + dynPrograms <- expr (flavour >>= dynamicGhcPrograms) + let ways = flavourWays ++ [contextWay] + pure [ if vanilla `elem` ways + then "--enable-library-vanilla" + else "--disable-library-vanilla" + , if vanilla `elem` ways && withGhci && not dynPrograms + then "--enable-library-for-ghci" + else "--disable-library-for-ghci" + , if or [Profiling `wayUnit` way | way <- ways] + then "--enable-library-profiling" + else "--disable-library-profiling" + , if or [Dynamic `wayUnit` way | way <- ways] + then "--enable-shared" + else "--disable-shared" ] + +-- TODO: LD_OPTS? +configureArgs :: Args +configureArgs = do + top <- expr topDirectory + root <- getBuildRoot + pkg <- getPackage + let conf key expr = do + values <- unwords <$> expr + not (null values) ? + arg ("--configure-option=" ++ key ++ "=" ++ values) + cFlags = mconcat [ remove ["-Werror"] cArgs + , getStagedSettingList ConfCcArgs + , arg $ "-I" ++ top -/- root -/- generatedDir + -- See https://github.com/snowleopard/hadrian/issues/523 + , arg $ "-I" ++ top -/- pkgPath pkg + , arg $ "-I" ++ top -/- "includes" ] + ldFlags = ldArgs <> (getStagedSettingList ConfGccLinkerArgs) + cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs) + cldFlags <- unwords <$> (cFlags <> ldFlags) + mconcat + [ conf "CFLAGS" cFlags + , conf "LDFLAGS" ldFlags + , conf "CPPFLAGS" cppFlags + , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags) + , conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir + , conf "--with-iconv-libraries" $ arg =<< getSetting IconvLibDir + , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir + , conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir + , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir + , flag CrossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) + , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage + , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] + +bootPackageConstraints :: Args +bootPackageConstraints = stage0 ? do + bootPkgs <- expr $ stagePackages Stage0 + let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs + constraints <- expr $ forM (sort pkgs) $ \pkg -> do + version <- pkgVersion pkg + return $ ((pkgName pkg ++ " == ") ++) version + pure $ concat [ ["--constraint", c] | c <- constraints ] + +cppArgs :: Args +cppArgs = do + root <- getBuildRoot + arg $ "-I" ++ root -/- generatedDir + +withBuilderKey :: Builder -> String +withBuilderKey b = case b of + Ar _ _ -> "--with-ar=" + Ld _ -> "--with-ld=" + Cc _ _ -> "--with-gcc=" + Ghc _ _ -> "--with-ghc=" + Alex -> "--with-alex=" + Happy -> "--with-happy=" + GhcPkg _ _ -> "--with-ghc-pkg=" + _ -> error $ "withBuilderKey: not supported builder " ++ show b + +-- | Add arguments to builders if needed. +withBuilderArgs :: Builder -> Args +withBuilderArgs b = case b of + GhcPkg _ stage -> do + top <- expr topDirectory + pkgDb <- expr $ packageDbPath stage + notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb) + _ -> return [] -- no arguments + +-- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex. +with :: Builder -> Args +with b = do + path <- getBuilderPath b + if null path then mempty else do + top <- expr topDirectory + expr $ needBuilder b + arg $ withBuilderKey b ++ unifyPath (top </> path) + +withStaged :: (Stage -> Builder) -> Args +withStaged sb = with . sb =<< getStage diff --git a/hadrian/src/Settings/Builders/Cc.hs b/hadrian/src/Settings/Builders/Cc.hs new file mode 100644 index 0000000000..e0055f3e8b --- /dev/null +++ b/hadrian/src/Settings/Builders/Cc.hs @@ -0,0 +1,28 @@ +module Settings.Builders.Cc (ccBuilderArgs) where + +import Hadrian.Haskell.Cabal.Type +import Settings.Builders.Common + +ccBuilderArgs :: Args +ccBuilderArgs = do + way <- getWay + builder Cc ? mconcat + [ getContextData ccOpts + , getStagedSettingList ConfCcArgs + + , builder (Cc CompileC) ? mconcat + [ arg "-Wall" + , cIncludeArgs + , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] + , arg "-c", arg =<< getInput + , arg "-o", arg =<< getOutput ] + + , builder (Cc FindCDependencies) ? do + output <- getOutput + mconcat [ arg "-E" + , arg "-MM", arg "-MG" + , arg "-MF", arg output + , arg "-MT", arg $ dropExtension output -<.> "o" + , cIncludeArgs + , arg "-x", arg "c" + , arg =<< getInput ] ] diff --git a/hadrian/src/Settings/Builders/Common.hs b/hadrian/src/Settings/Builders/Common.hs new file mode 100644 index 0000000000..6846c4bc8d --- /dev/null +++ b/hadrian/src/Settings/Builders/Common.hs @@ -0,0 +1,73 @@ +module Settings.Builders.Common ( + module Base, + module Expression, + module Oracles.Flag, + module Oracles.Setting, + module Settings, + module UserSettings, + cIncludeArgs, ldArgs, cArgs, cWarnings, + packageDatabaseArgs, bootPackageDatabaseArgs + ) where + +import Hadrian.Haskell.Cabal.Type + +import Base +import Expression +import Oracles.Flag +import Oracles.Setting +import Packages +import Settings +import UserSettings + +cIncludeArgs :: Args +cIncludeArgs = do + pkg <- getPackage + root <- getBuildRoot + path <- getBuildPath + incDirs <- getContextData includeDirs + depDirs <- getContextData depIncludeDirs + iconvIncludeDir <- getSetting IconvIncludeDir + gmpIncludeDir <- getSetting GmpIncludeDir + ffiIncludeDir <- getSetting FfiIncludeDir + mconcat [ notStage0 ||^ package compiler ? arg "-Iincludes" + , arg $ "-I" ++ root -/- generatedDir + , arg $ "-I" ++ path + , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] + , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir) + -- Add @incDirs@ in the build directory, since some files generated + -- with @autoconf@ may end up in the build directory. + , pure [ "-I" ++ path -/- dir | dir <- incDirs ] + -- Add @incDirs@ in the package directory for include files shipped + -- with the package. + , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ] + , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ] + +ldArgs :: Args +ldArgs = mempty + +cArgs :: Args +cArgs = mempty + +-- TODO: should be in a different file +cWarnings :: Args +cWarnings = mconcat + [ arg "-Wall" + , flag GccIsClang ? arg "-Wno-unknown-pragmas" + , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable" + , notM (flag GccIsClang) ? arg "-Wno-error=inline" ] + +packageDatabaseArgs :: Args +packageDatabaseArgs = do + stage <- getStage + dbPath <- expr (packageDbPath stage) + expr (need [dbPath -/- packageDbStamp]) + root <- getBuildRoot + prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") + arg $ prefix ++ root -/- relativePackageDbPath stage + +bootPackageDatabaseArgs :: Args +bootPackageDatabaseArgs = do + stage <- getStage + dbPath <- expr $ packageDbPath stage + expr $ need [dbPath -/- packageDbStamp] + stage0 ? packageDatabaseArgs diff --git a/hadrian/src/Settings/Builders/Configure.hs b/hadrian/src/Settings/Builders/Configure.hs new file mode 100644 index 0000000000..068591dfbb --- /dev/null +++ b/hadrian/src/Settings/Builders/Configure.hs @@ -0,0 +1,25 @@ +module Settings.Builders.Configure (configureBuilderArgs) where + +import Packages +import Rules.Gmp +import Settings.Builders.Common + +configureBuilderArgs :: Args +configureBuilderArgs = do + gmpPath <- expr gmpBuildPath + libffiPath <- expr libffiBuildPath + mconcat [ builder (Configure gmpPath) ? do + hostPlatform <- getSetting HostPlatform + buildPlatform <- getSetting BuildPlatform + pure [ "--enable-shared=no" + , "--host=" ++ hostPlatform + , "--build=" ++ buildPlatform ] + + , builder (Configure libffiPath) ? do + top <- expr topDirectory + targetPlatform <- getSetting TargetPlatform + pure [ "--prefix=" ++ top -/- libffiPath -/- "inst" + , "--libdir=" ++ top -/- libffiPath -/- "inst/lib" + , "--enable-static=yes" + , "--enable-shared=no" -- TODO: add support for yes + , "--host=" ++ targetPlatform ] ] diff --git a/hadrian/src/Settings/Builders/DeriveConstants.hs b/hadrian/src/Settings/Builders/DeriveConstants.hs new file mode 100644 index 0000000000..bd7511be23 --- /dev/null +++ b/hadrian/src/Settings/Builders/DeriveConstants.hs @@ -0,0 +1,40 @@ +module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where + +import Builder +import Settings.Builders.Common + +-- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`? +deriveConstantsBuilderArgs :: Args +deriveConstantsBuilderArgs = builder DeriveConstants ? do + cFlags <- includeCcArgs + outs <- getOutputs + let (outputFile, tempDir) = case outs of + [a, b] -> (a, b) + _ -> error $ "DeriveConstants: expected two outputs, got " ++ show outs + mconcat + [ output "//DerivedConstants.h" ? arg "--gen-header" + , output "//GHCConstantsHaskellType.hs" ? arg "--gen-haskell-type" + , output "//platformConstants" ? arg "--gen-haskell-value" + , output "//GHCConstantsHaskellWrappers.hs" ? arg "--gen-haskell-wrappers" + , output "//GHCConstantsHaskellExports.hs" ? arg "--gen-haskell-exports" + , arg "-o", arg outputFile + , arg "--tmpdir", arg tempDir + , arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1) + , pure $ concatMap (\a -> ["--gcc-flag", a]) cFlags + , arg "--nm-program", arg =<< getBuilderPath Nm + , isSpecified Objdump ? mconcat [ arg "--objdump-program" + , arg =<< getBuilderPath Objdump ] + , arg "--target-os", arg =<< getSetting TargetOs ] + +includeCcArgs :: Args +includeCcArgs = do + root <- getBuildRoot + mconcat [ cArgs + , cWarnings + , getSettingList $ ConfCcArgs Stage1 + , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER" + , arg "-Irts" + , arg "-Iincludes" + , arg $ "-I" ++ root -/- generatedDir + , notM ghcWithSMP ? arg "-DNOSMP" + , arg "-fcommon" ] diff --git a/hadrian/src/Settings/Builders/GenPrimopCode.hs b/hadrian/src/Settings/Builders/GenPrimopCode.hs new file mode 100644 index 0000000000..e616ed3b43 --- /dev/null +++ b/hadrian/src/Settings/Builders/GenPrimopCode.hs @@ -0,0 +1,24 @@ +module Settings.Builders.GenPrimopCode (genPrimopCodeBuilderArgs) where + +import Settings.Builders.Common + +genPrimopCodeBuilderArgs :: Args +genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat + [ output "//PrimopWrappers.hs" ? arg "--make-haskell-wrappers" + , output "//Prim.hs" ? arg "--make-haskell-source" + , output "//primop-data-decl.hs-incl" ? arg "--data-decl" + , output "//primop-tag.hs-incl" ? arg "--primop-tag" + , output "//primop-list.hs-incl" ? arg "--primop-list" + , output "//primop-has-side-effects.hs-incl" ? arg "--has-side-effects" + , output "//primop-out-of-line.hs-incl" ? arg "--out-of-line" + , output "//primop-commutable.hs-incl" ? arg "--commutable" + , output "//primop-code-size.hs-incl" ? arg "--code-size" + , output "//primop-can-fail.hs-incl" ? arg "--can-fail" + , output "//primop-strictness.hs-incl" ? arg "--strictness" + , output "//primop-fixity.hs-incl" ? arg "--fixity" + , output "//primop-primop-info.hs-incl" ? arg "--primop-primop-info" + , output "//primop-vector-uniques.hs-incl" ? arg "--primop-vector-uniques" + , output "//primop-vector-tys.hs-incl" ? arg "--primop-vector-tys" + , output "//primop-vector-tys-exports.hs-incl" ? arg "--primop-vector-tys-exports" + , output "//primop-vector-tycons.hs-incl" ? arg "--primop-vector-tycons" + , output "//primop-usage.hs-incl" ? arg "--usage" ] diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs new file mode 100644 index 0000000000..8212b5fbcf --- /dev/null +++ b/hadrian/src/Settings/Builders/Ghc.hs @@ -0,0 +1,134 @@ +module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where + +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Type + +import Flavour +import Packages +import Settings.Builders.Common +import Settings.Warnings + +ghcBuilderArgs :: Args +ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] + +compileAndLinkHs :: Args +compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do + mconcat [ arg "-Wall" + , commonGhcArgs + , splitObjects <$> flavour ? arg "-split-objs" + , ghcLinkArgs + , defaultGhcWarningsArgs + , builder (Ghc CompileHs) ? arg "-c" + , getInputs + , arg "-o", arg =<< getOutput ] + +compileC :: Args +compileC = builder (Ghc CompileCWithGhc) ? do + way <- getWay + let ccArgs = [ getContextData ccOpts + , getStagedSettingList ConfCcArgs + , cIncludeArgs + , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ] + mconcat [ arg "-Wall" + , ghcLinkArgs + , commonGhcArgs + , mconcat (map (map ("-optc" ++) <$>) ccArgs) + , defaultGhcWarningsArgs + , arg "-c" + , getInputs + , arg "-o" + , arg =<< getOutput ] + +ghcLinkArgs :: Args +ghcLinkArgs = builder (Ghc LinkHs) ? do + way <- getWay + pkg <- getPackage + libs <- pkg == hp2ps ? pure ["m"] + intLib <- getIntegerPackage + gmpLibs <- notStage0 ? intLib == integerGmp ? pure ["gmp"] + mconcat [ (Dynamic `wayUnit` way) ? + pure [ "-shared", "-dynamic", "-dynload", "deploy" ] + , arg "-no-auto-link-packages" + , nonHsMainPackage pkg ? arg "-no-hs-main" + , not (nonHsMainPackage pkg) ? arg "-rtsopts" + , pure [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ] + ] + +findHsDependencies :: Args +findHsDependencies = builder (Ghc FindHsDependencies) ? do + ways <- getLibraryWays + mconcat [ arg "-M" + , commonGhcArgs + , arg "-include-pkg-deps" + , arg "-dep-makefile", arg =<< getOutput + , pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ] + , getInputs ] + +haddockGhcArgs :: Args +haddockGhcArgs = mconcat [ commonGhcArgs, getContextData hcOpts ] + +-- | Common GHC command line arguments used in 'ghcBuilderArgs', +-- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'. +commonGhcArgs :: Args +commonGhcArgs = do + way <- getWay + path <- getBuildPath + ghcVersion <- expr ghcVersionH + mconcat [ arg "-hisuf", arg $ hisuf way + , arg "-osuf" , arg $ osuf way + , arg "-hcsuf", arg $ hcsuf way + , wayGhcArgs + , packageGhcArgs + , includeGhcArgs + -- When compiling RTS for Stage1 or Stage2 we do not have it (yet) + -- in the package database. We therefore explicity supply the path + -- to the @ghc-version@ file, to prevent GHC from trying to open the + -- RTS package in the package database and failing. + , package rts ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion) + , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs + , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs + , map ("-optP" ++) <$> getContextData cppOpts + , arg "-odir" , arg path + , arg "-hidir" , arg path + , arg "-stubdir" , arg path ] + +-- TODO: Do '-ticky' in all debug ways? +wayGhcArgs :: Args +wayGhcArgs = do + way <- getWay + mconcat [ if (Dynamic `wayUnit` way) + then pure ["-fPIC", "-dynamic"] + else arg "-static" + , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS" + , (Debug `wayUnit` way) ? arg "-optc-DDEBUG" + , (Profiling `wayUnit` way) ? arg "-prof" + , (Logging `wayUnit` way) ? arg "-eventlog" + , (way == debug || way == debugDynamic) ? + pure ["-ticky", "-DTICKY_TICKY"] ] + +packageGhcArgs :: Args +packageGhcArgs = do + package <- getPackage + pkgId <- expr $ pkgIdentifier package + mconcat [ arg "-hide-all-packages" + , arg "-no-user-package-db" + , packageDatabaseArgs + , libraryPackage ? arg ("-this-unit-id " ++ pkgId) + , map ("-package-id " ++) <$> getContextData depIds ] + +includeGhcArgs :: Args +includeGhcArgs = do + pkg <- getPackage + path <- getBuildPath + root <- getBuildRoot + context <- getContext + srcDirs <- getContextData srcDirs + autogen <- expr $ autogenPath context + mconcat [ arg "-i" + , arg $ "-i" ++ path + , arg $ "-i" ++ autogen + , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ] + , cIncludeArgs + , arg $ "-I" ++ root -/- generatedDir + , arg $ "-optc-I" ++ root -/- generatedDir + , pure ["-optP-include", "-optP" ++ autogen -/- "cabal_macros.h"] ] diff --git a/hadrian/src/Settings/Builders/GhcPkg.hs b/hadrian/src/Settings/Builders/GhcPkg.hs new file mode 100644 index 0000000000..bc8303f5a1 --- /dev/null +++ b/hadrian/src/Settings/Builders/GhcPkg.hs @@ -0,0 +1,39 @@ +module Settings.Builders.GhcPkg (ghcPkgBuilderArgs) where + +import Settings.Builders.Common + +ghcPkgBuilderArgs :: Args +ghcPkgBuilderArgs = mconcat + [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ] + , builder (GhcPkg Copy) ? do + verbosity <- expr getVerbosity + stage <- getStage + pkgDb <- expr $ packageDbPath stage + mconcat [ arg "--global-package-db" + , arg pkgDb + , arg "register" + , verbosity < Chatty ? arg "-v0" + ] + , builder (GhcPkg Unregister) ? do + verbosity <- expr getVerbosity + stage <- getStage + pkgDb <- expr $ packageDbPath stage + mconcat [ arg "--global-package-db" + , arg pkgDb + , arg "unregister" + , arg "--force" + , verbosity < Chatty ? arg "-v0" + ] + , builder (GhcPkg Update) ? do + verbosity <- expr getVerbosity + context <- getContext + config <- expr $ pkgInplaceConfig context + stage <- getStage + pkgDb <- expr $ packageDbPath stage + mconcat [ notStage0 ? arg "--global-package-db" + , notStage0 ? arg pkgDb + , arg "update" + , arg "--force" + , verbosity < Chatty ? arg "-v0" + , bootPackageDatabaseArgs + , arg config ] ] diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs new file mode 100644 index 0000000000..2830c209e7 --- /dev/null +++ b/hadrian/src/Settings/Builders/Haddock.hs @@ -0,0 +1,71 @@ +module Settings.Builders.Haddock (haddockBuilderArgs) where + +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Type +import Hadrian.Utilities + +import Packages +import Rules.Documentation +import Settings.Builders.Common +import Settings.Builders.Ghc + +-- | Given a version string such as "2.16.2" produce an integer equivalent. +versionToInt :: String -> Int +versionToInt = read . dropWhile (=='0') . filter (/='.') + +haddockBuilderArgs :: Args +haddockBuilderArgs = mconcat + [ builder (Haddock BuildIndex) ? do + output <- getOutput + inputs <- getInputs + root <- getBuildRoot + mconcat + [ arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "docs" + , arg "--gen-index" + , arg "--gen-contents" + , arg "-o", arg $ takeDirectory output + , arg "-t", arg "Haskell Hierarchical Libraries" + , arg "-p", arg "libraries/prologue.txt" + , pure [ "--read-interface=" + ++ (takeFileName . takeDirectory) haddock + ++ "," ++ haddock | haddock <- inputs ] ] + + , builder (Haddock BuildPackage) ? do + output <- getOutput + pkg <- getPackage + root <- getBuildRoot + path <- getBuildPath + context <- getContext + version <- expr $ pkgVersion pkg + synopsis <- expr $ pkgSynopsis pkg + deps <- getContextData depNames + haddocks <- expr $ haddockDependencies context + hVersion <- expr $ pkgVersion haddock + ghcOpts <- haddockGhcArgs + mconcat + [ arg "--verbosity=0" + , arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "docs" + , arg $ "--odir=" ++ takeDirectory output + , arg "--no-tmp-comp-dir" + , arg $ "--dump-interface=" ++ output + , arg "--html" + , arg "--hyperlinked-source" + , arg "--hoogle" + , arg "--quickjump" + , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version + ++ ": " ++ synopsis + , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" + , arg $ "--optghc=-D__HADDOCK_VERSION__=" + ++ show (versionToInt hVersion) + , map ("--hide=" ++) <$> getContextData otherModules + , pure [ "--read-interface=../" ++ dep + ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME}," + ++ haddock | (dep, haddock) <- zip deps haddocks ] + , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] + , getInputs + , arg "+RTS" + , arg $ "-t" ++ path -/- "haddock.t" + , arg "--machine-readable" + , arg "-RTS" ] ] diff --git a/hadrian/src/Settings/Builders/Happy.hs b/hadrian/src/Settings/Builders/Happy.hs new file mode 100644 index 0000000000..5ffb2614cc --- /dev/null +++ b/hadrian/src/Settings/Builders/Happy.hs @@ -0,0 +1,9 @@ +module Settings.Builders.Happy (happyBuilderArgs) where + +import Settings.Builders.Common + +happyBuilderArgs :: Args +happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" + , arg "--strict" + , arg =<< getInput + , arg "-o", arg =<< getOutput ] diff --git a/hadrian/src/Settings/Builders/HsCpp.hs b/hadrian/src/Settings/Builders/HsCpp.hs new file mode 100644 index 0000000000..e33061c9d0 --- /dev/null +++ b/hadrian/src/Settings/Builders/HsCpp.hs @@ -0,0 +1,17 @@ +module Settings.Builders.HsCpp (hsCppBuilderArgs) where + +import Packages +import Settings.Builders.Common + +hsCppBuilderArgs :: Args +hsCppBuilderArgs = builder HsCpp ? do + stage <- getStage + root <- getBuildRoot + ghcPath <- expr $ buildPath (vanillaContext stage compiler) + mconcat [ getSettingList HsCppArgs + , arg "-P" + , arg "-Iincludes" + , arg $ "-I" ++ root -/- generatedDir + , arg $ "-I" ++ ghcPath + , arg "-x", arg "c" + , arg =<< getInput ] diff --git a/hadrian/src/Settings/Builders/Hsc2Hs.hs b/hadrian/src/Settings/Builders/Hsc2Hs.hs new file mode 100644 index 0000000000..0d5363d413 --- /dev/null +++ b/hadrian/src/Settings/Builders/Hsc2Hs.hs @@ -0,0 +1,58 @@ +module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where + +import Hadrian.Haskell.Cabal.Type + +import Builder +import Packages +import Settings.Builders.Common + +hsc2hsBuilderArgs :: Args +hsc2hsBuilderArgs = builder Hsc2Hs ? do + stage <- getStage + ccPath <- getBuilderPath $ Cc CompileC stage + gmpDir <- getSetting GmpIncludeDir + top <- expr topDirectory + hArch <- getSetting HostArch + hOs <- getSetting HostOs + tArch <- getSetting TargetArch + tOs <- getSetting TargetOs + version <- if stage == Stage0 + then expr ghcCanonVersion + else getSetting ProjectVersionInt + tmpl <- (top -/-) <$> expr (templateHscPath Stage0) + mconcat [ arg $ "--cc=" ++ ccPath + , arg $ "--ld=" ++ ccPath + , notM windowsHost ? notM (flag CrossCompiling) ? arg "--cross-safe" + , pure $ map ("-I" ++) (words gmpDir) + , map ("--cflag=" ++) <$> getCFlags + , map ("--lflag=" ++) <$> getLFlags + , notStage0 ? flag CrossCompiling ? arg "--cross-compile" + , stage0 ? arg ("--cflag=-D" ++ hArch ++ "_HOST_ARCH=1") + , stage0 ? arg ("--cflag=-D" ++ hOs ++ "_HOST_OS=1" ) + , notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1") + , notStage0 ? arg ("--cflag=-D" ++ tOs ++ "_HOST_OS=1" ) + , arg $ "--cflag=-D__GLASGOW_HASKELL__=" ++ version + , arg $ "--template=" ++ tmpl + , arg =<< getInput + , arg "-o", arg =<< getOutput ] + +getCFlags :: Expr [String] +getCFlags = do + context <- getContext + autogen <- expr $ autogenPath context + mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) + , getStagedSettingList ConfCppArgs + , cIncludeArgs + , getContextData ccOpts + -- we might be able to leave out cppOpts, to be investigated. + , getContextData cppOpts + , getContextData depCcOpts + , cWarnings + , arg "-include", arg $ autogen -/- "cabal_macros.h" ] + +getLFlags :: Expr [String] +getLFlags = + mconcat [ getStagedSettingList ConfGccLinkerArgs + , ldArgs + , getContextData ldOpts + , getContextData depLdOpts ] diff --git a/hadrian/src/Settings/Builders/Ld.hs b/hadrian/src/Settings/Builders/Ld.hs new file mode 100644 index 0000000000..2715bbb20c --- /dev/null +++ b/hadrian/src/Settings/Builders/Ld.hs @@ -0,0 +1,9 @@ +module Settings.Builders.Ld (ldBuilderArgs) where + +import Settings.Builders.Common + +ldBuilderArgs :: Args +ldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs + , arg "-r" + , arg "-o", arg =<< getOutput + , getInputs ] diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs new file mode 100644 index 0000000000..102ba54845 --- /dev/null +++ b/hadrian/src/Settings/Builders/Make.hs @@ -0,0 +1,41 @@ +module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where + +import Oracles.Setting +import Packages +import Rules.Gmp +import Settings.Builders.Common +import CommandLine + +makeBuilderArgs :: Args +makeBuilderArgs = do + threads <- shakeThreads <$> expr getShakeOptions + gmpPath <- expr gmpBuildPath + libffiPath <- expr libffiBuildPath + let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads + mconcat + [ builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t] + , builder (Make libffiPath) ? pure ["MAKEFLAGS=-j" ++ t, "install"] ] + +validateBuilderArgs :: Args +validateBuilderArgs = builder (Make "testsuite/tests") ? do + threads <- shakeThreads <$> expr getShakeOptions + top <- expr topDirectory + compiler <- expr $ fullpath ghc + checkPpr <- expr $ fullpath checkPpr + checkApiAnnotations <- expr $ fullpath checkApiAnnotations + args <- expr $ userSetting defaultTestArgs + return [ setTestSpeed $ testSpeed args + , "THREADS=" ++ show threads + , "TEST_HC=" ++ (top -/- compiler) + , "CHECK_PPR=" ++ (top -/- checkPpr) + , "CHECK_API_ANNOTATIONS=" ++ (top -/- checkApiAnnotations) + ] + where + fullpath :: Package -> Action FilePath + fullpath pkg = programPath =<< programContext Stage1 pkg + +-- | Support for speed of validation +setTestSpeed :: TestSpeed -> String +setTestSpeed Fast = "fasttest" +setTestSpeed Average = "test" +setTestSpeed Slow = "slowtest" diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs new file mode 100644 index 0000000000..734fecdb49 --- /dev/null +++ b/hadrian/src/Settings/Builders/RunTest.hs @@ -0,0 +1,205 @@ +module Settings.Builders.RunTest (runTestBuilderArgs, runTestGhcFlags) where + +import Hadrian.Utilities +import System.Environment + +import CommandLine +import Flavour +import Oracles.Setting (setting) +import Oracles.TestSettings +import Packages +import Settings.Builders.Common + +getTestSetting :: TestSetting -> Expr String +getTestSetting key = expr $ testSetting key + +-- | Parse the value of a Boolean test setting or report an error. +getBooleanSetting :: TestSetting -> Expr Bool +getBooleanSetting key = fromMaybe (error msg) <$> parseYesNo <$> getTestSetting key + where + msg = "Cannot parse test setting " ++ quote (show key) + +-- | Extra flags to send to the Haskell compiler to run tests. +runTestGhcFlags :: Action String +runTestGhcFlags = do + unregisterised <- flag GhcUnregisterised + + let ifMinGhcVer ver opt = do v <- ghcCanonVersion + if ver <= v then pure opt + else pure "" + + -- Read extra argument for test from command line, like `-fvectorize`. + ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS") + + -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28 + let ghcExtraFlags = if unregisterised + then "-optc-fno-builtin" + else "" + + -- Take flags to send to the Haskell compiler from test.mk. + -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37 + unwords <$> sequence + [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts" + , pure ghcOpts + , pure ghcExtraFlags + , ifMinGhcVer "711" "-fno-warn-missed-specialisations" + , ifMinGhcVer "711" "-fshow-warning-groups" + , ifMinGhcVer "801" "-fdiagnostics-color=never" + , ifMinGhcVer "801" "-fno-diagnostics-show-caret" + , pure "-dno-debug-output" + ] + +-- Command line arguments for invoking the @runtest.py@ script. A lot of this +-- mirrors @testsuite/mk/test.mk@. +runTestBuilderArgs :: Args +runTestBuilderArgs = builder RunTest ? do + pkgs <- expr $ stagePackages Stage1 + libTests <- expr $ filterM doesDirectoryExist $ concat + [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ] + | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ] + + flav <- expr flavour + rtsWays <- expr testRTSSettings + libWays <- libraryWays flav + let hasRtsWay w = elem w rtsWays + hasLibWay w = elem w libWays + debugged = ghcDebugged flav + hasDynamic <- getBooleanSetting TestGhcDynamic + hasDynamicByDefault <- getBooleanSetting TestGhcDynamicByDefault + withNativeCodeGen <- getBooleanSetting TestGhcWithNativeCodeGen + withInterpreter <- getBooleanSetting TestGhcWithInterpreter + unregisterised <- getBooleanSetting TestGhcUnregisterised + withSMP <- getBooleanSetting TestGhcWithSMP + + windows <- expr windowsHost + darwin <- expr osxHost + threads <- shakeThreads <$> expr getShakeOptions + os <- getTestSetting TestHostOS + arch <- getTestSetting TestTargetARCH_CPP + platform <- getTestSetting TestTARGETPLATFORM + wordsize <- getTestSetting TestWORDSIZE + top <- expr $ topDirectory + ghcFlags <- expr runTestGhcFlags + timeoutProg <- expr buildRoot <&> (-/- timeoutPath) + + let asZeroOne s b = s ++ zeroOne b + + -- TODO: set CABAL_MINIMAL_BUILD/CABAL_PLUGIN_BUILD + mconcat [ arg $ "testsuite/driver/runtests.py" + , arg $ "--rootdir=" ++ ("testsuite" -/- "tests") + , pure ["--rootdir=" ++ test | test <- libTests] + , arg "-e", arg $ "windows=" ++ show windows + , arg "-e", arg $ "darwin=" ++ show darwin + , arg "-e", arg $ "config.local=True" + , arg "-e", arg $ "config.cleanup=False" -- Don't clean up. + , arg "-e", arg $ "config.compiler_debugged=" ++ quote (yesNo debugged) + , arg "-e", arg $ "ghc_debugged=" ++ quote (yesNo debugged) + , arg "-e", arg $ asZeroOne "ghc_with_native_codegen=" withNativeCodeGen + + , arg "-e", arg $ "config.have_interp=" ++ show withInterpreter + , arg "-e", arg $ "config.unregisterised=" ++ show unregisterised + + , arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags + , arg "-e", arg $ asZeroOne "ghc_with_dynamic_rts=" (hasRtsWay "dyn") + , arg "-e", arg $ asZeroOne "ghc_with_threaded_rts=" (hasRtsWay "thr") + , arg "-e", arg $ asZeroOne "config.have_vanilla=" (hasLibWay vanilla) + , arg "-e", arg $ asZeroOne "config.have_dynamic=" (hasLibWay dynamic) + , arg "-e", arg $ asZeroOne "config.have_profiling=" (hasLibWay profiling) + , arg "-e", arg $ asZeroOne "ghc_with_smp=" withSMP + , arg "-e", arg $ "ghc_with_llvm=0" -- TODO: support LLVM + + , arg "-e", arg $ "config.ghc_dynamic_by_default=" ++ show hasDynamicByDefault + , arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic + + -- Use default value, see: + -- https://github.com/ghc/ghc/blob/master/testsuite/mk/boilerplate.mk + , arg "-e", arg $ "config.in_tree_compiler=True" + , arg "-e", arg $ "config.top=" ++ show (top -/- "testsuite") + , arg "-e", arg $ "config.wordsize=" ++ show wordsize + , arg "-e", arg $ "config.os=" ++ show os + , arg "-e", arg $ "config.arch=" ++ show arch + , arg "-e", arg $ "config.platform=" ++ show platform + + , arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk + , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg) + , arg $ "--threads=" ++ show threads + , getTestArgs -- User-provided arguments from command line. + ] + +-- | Command line arguments for running GHC's test script. +getTestArgs :: Args +getTestArgs = do + args <- expr $ userSetting defaultTestArgs + bindir <- expr $ setBinaryDirectory (testCompiler args) + compiler <- expr $ setCompiler (testCompiler args) + globalVerbosity <- shakeVerbosity <$> expr getShakeOptions + let configFileArg= ["--config-file=" ++ (testConfigFile args)] + testOnlyArg = case testOnly args of + Just cases -> map ("--only=" ++) (words cases) + Nothing -> [] + onlyPerfArg = if testOnlyPerf args + then Just "--only-perf-tests" + else Nothing + skipPerfArg = if testSkipPerf args + then Just "--skip-perf-tests" + else Nothing + speedArg = ["-e", "config.speed=" ++ setTestSpeed (testSpeed args)] + summaryArg = case testSummary args of + Just filepath -> Just $ "--summary-file" ++ quote filepath + Nothing -> Just $ "--summary-file=testsuite_summary.txt" + junitArg = case testJUnit args of + Just filepath -> Just $ "--junit " ++ quote filepath + Nothing -> Nothing + configArgs = concat [["-e", configArg] | configArg <- testConfigs args] + verbosityArg = case testVerbosity args of + Nothing -> Just $ "--verbose=" ++ show (fromEnum globalVerbosity) + Just verbosity -> Just $ "--verbose=" ++ verbosity + wayArgs = map ("--way=" ++) (testWays args) + compilerArg = ["--config", "compiler=" ++ show (compiler)] + ghcPkgArg = ["--config", "ghc_pkg=" ++ show (bindir -/- "ghc-pkg")] + haddockArg = ["--config", "haddock=" ++ show (bindir -/- "haddock")] + hp2psArg = ["--config", "hp2ps=" ++ show (bindir -/- "hp2ps")] + hpcArg = ["--config", "hpc=" ++ show (bindir -/- "hpc")] + pure $ configFileArg ++ testOnlyArg ++ speedArg + ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg + , junitArg, verbosityArg ] + ++ configArgs ++ wayArgs ++ compilerArg ++ ghcPkgArg + ++ haddockArg ++ hp2psArg ++ hpcArg + +-- TODO: Switch to 'Stage' as the first argument instead of 'String'. +-- | Directory to look for Binaries +-- | We assume that required programs are present in the same binary directory +-- | in which ghc is stored and that they have their conventional name. +-- | QUESTION : packages can be named different from their conventional names. +-- | For example, ghc-pkg can be named as ghc-pkg-version. In such cases, it will +-- | be impossible to search the binary. Only possible way will be to take user +-- | inputs for these directory also. boilerplate soes not account for this +-- | problem, but simply returns an error. How should we handle such cases? +setBinaryDirectory :: String -> Action FilePath +setBinaryDirectory "stage0" = takeDirectory <$> setting SystemGhc +setBinaryDirectory "stage1" = liftM2 (-/-) topDirectory (stageBinPath Stage0) +setBinaryDirectory "stage2" = liftM2 (-/-) topDirectory (stageBinPath Stage1) +setBinaryDirectory compiler = pure $ parentPath compiler + +-- TODO: Switch to 'Stage' as the first argument instead of 'String'. +-- | Set Test Compiler. +setCompiler :: String -> Action FilePath +setCompiler "stage0" = setting SystemGhc +setCompiler "stage1" = liftM2 (-/-) topDirectory (fullPath Stage0 ghc) +setCompiler "stage2" = liftM2 (-/-) topDirectory (fullPath Stage1 ghc) +setCompiler compiler = pure compiler + +-- | Set speed for test +setTestSpeed :: TestSpeed -> String +setTestSpeed Slow = "0" +setTestSpeed Average = "1" +setTestSpeed Fast = "2" + +-- | Returns parent path of test compiler +-- | TODO: Is there a simpler way to find parent directory? +parentPath :: String -> String +parentPath path = intercalate "/" $ init $ splitOn "/" path + +-- | TODO: Move to Hadrian utilities. +fullPath :: Stage -> Package -> Action FilePath +fullPath stage pkg = programPath =<< programContext stage pkg diff --git a/hadrian/src/Settings/Builders/Xelatex.hs b/hadrian/src/Settings/Builders/Xelatex.hs new file mode 100644 index 0000000000..5623284ed5 --- /dev/null +++ b/hadrian/src/Settings/Builders/Xelatex.hs @@ -0,0 +1,7 @@ +module Settings.Builders.Xelatex (xelatexBuilderArgs) where + +import Settings.Builders.Common + +xelatexBuilderArgs :: Args +xelatexBuilderArgs = builder Xelatex ? mconcat [ arg "-halt-on-error" + , arg =<< getInput ] diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs new file mode 100644 index 0000000000..031bd45ace --- /dev/null +++ b/hadrian/src/Settings/Default.hs @@ -0,0 +1,274 @@ +module Settings.Default ( + -- * Packages that are build by default and for the testsuite + defaultPackages, testsuitePackages, + + -- * Default build ways + defaultLibraryWays, defaultRtsWays, + + -- * Default command line arguments for various builders + SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, + defaultArgs, + + -- * Default build flavour + defaultFlavour, defaultSplitObjects + ) where + +import qualified Hadrian.Builder.Ar +import qualified Hadrian.Builder.Sphinx +import qualified Hadrian.Builder.Tar +import Hadrian.Haskell.Cabal.Type + +import CommandLine +import Expression +import Flavour +import Oracles.Flag +import Oracles.Setting +import Packages +import Settings +import Settings.Builders.Alex +import Settings.Builders.DeriveConstants +import Settings.Builders.Cabal +import Settings.Builders.Cc +import Settings.Builders.Configure +import Settings.Builders.GenPrimopCode +import Settings.Builders.Ghc +import Settings.Builders.GhcPkg +import Settings.Builders.Haddock +import Settings.Builders.Happy +import Settings.Builders.Hsc2Hs +import Settings.Builders.HsCpp +import Settings.Builders.Ld +import Settings.Builders.Make +import Settings.Builders.RunTest +import Settings.Builders.Xelatex +import Settings.Packages +import Settings.Warnings + +-- | Packages that are built by default. You can change this in "UserSettings". +defaultPackages :: Stage -> Action [Package] +defaultPackages Stage0 = stage0Packages +defaultPackages Stage1 = stage1Packages +defaultPackages Stage2 = stage2Packages +defaultPackages Stage3 = return [] + +-- | Packages built in 'Stage0' by default. You can change this in "UserSettings". +stage0Packages :: Action [Package] +stage0Packages = do + win <- windowsHost + cross <- flag CrossCompiling + return $ [ binary + , cabal + , compareSizes + , compiler + , deriveConstants + , genapply + , genprimopcode + , ghc + , ghcBoot + , ghcBootTh + , ghcHeap + , ghci + , ghcPkg + , hsc2hs + , hpc + , mtl + , parsec + , templateHaskell + , text + , transformers + , unlit ] + ++ [ terminfo | not win, not cross ] + ++ [ touchy | win ] + +-- | Packages built in 'Stage1' by default. You can change this in "UserSettings". +stage1Packages :: Action [Package] +stage1Packages = do + win <- windowsHost + intLib <- integerLibrary =<< flavour + libraries0 <- filter isLibrary <$> stage0Packages + cross <- flag CrossCompiling + return $ libraries0 -- Build all Stage0 libraries in Stage1 + ++ [ array + , base + , bytestring + , containers + , deepseq + , directory + , filepath + , ghc + , ghcCompact + , ghcPkg + , ghcPrim + , haskeline + , hsc2hs + , intLib + , pretty + , process + , rts + , stm + , time + , unlit + , xhtml ] + ++ [ hpcBin | not cross ] + ++ [ iserv | not win, not cross ] + ++ [ libiserv | not win, not cross ] + ++ [ runGhc | not cross ] + ++ [ touchy | win ] + ++ [ unix | not win ] + ++ [ win32 | win ] + +-- | Packages built in 'Stage2' by default. You can change this in "UserSettings". +stage2Packages :: Action [Package] +stage2Packages = do + cross <- flag CrossCompiling + return $ [ ghcTags ] + ++ [ haddock | not cross ] + +-- | Packages that are built only for the testsuite. +testsuitePackages :: Action [Package] +testsuitePackages = do + win <- windowsHost + return $ [ checkApiAnnotations + , checkPpr + , ghci + , ghcCompact + , ghcPkg + , hp2ps + , hsc2hs + , iserv + , parallel + , runGhc + , unlit ] ++ + [ timeout | win ] + +-- | Default build ways for library packages: +-- * We always build 'vanilla' way. +-- * We build 'profiling' way when stage > Stage0. +-- * We build 'dynamic' way when stage > Stage0 and the platform supports it. +defaultLibraryWays :: Ways +defaultLibraryWays = mconcat + [ pure [vanilla] + , notStage0 ? pure [profiling] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + ] + +-- | Default build ways for the RTS. +defaultRtsWays :: Ways +defaultRtsWays = mconcat + [ pure [vanilla, threaded] + , notStage0 ? pure + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , logging, threadedLogging + , debug, threadedDebug + ] + , notStage0 ? platformSupportsSharedLibs ? pure + [ dynamic, threadedDynamic, debugDynamic, loggingDynamic + , threadedDebugDynamic, threadedLoggingDynamic + ] + ] + +-- TODO: Move C source arguments here +-- | Default and package-specific source arguments. +data SourceArgs = SourceArgs + { hsDefault :: Args + , hsLibrary :: Args + , hsCompiler :: Args + , hsGhc :: Args } + +-- | Concatenate source arguments in appropriate order. +sourceArgs :: SourceArgs -> Args +sourceArgs SourceArgs {..} = builder Ghc ? mconcat + [ hsDefault + , getContextData hcOpts + , libraryPackage ? hsLibrary + , package compiler ? hsCompiler + , package ghc ? hsGhc ] + +-- | All default command line arguments. +defaultArgs :: Args +defaultArgs = mconcat + [ defaultBuilderArgs + , sourceArgs defaultSourceArgs + , defaultPackageArgs ] + +-- | Default source arguments, e.g. optimisation settings. +defaultSourceArgs :: SourceArgs +defaultSourceArgs = SourceArgs + { hsDefault = mconcat [ stage0 ? arg "-O" + , notStage0 ? arg "-O2" + , arg "-H32m" ] + , hsLibrary = mempty + , hsCompiler = mempty + , hsGhc = mempty } + +-- Please update doc/flavours.md when changing the default build flavour. +-- | Default build flavour. Other build flavours are defined in modules +-- @Settings.Flavours.*@. Users can add new build flavours in "UserSettings". +defaultFlavour :: Flavour +defaultFlavour = Flavour + { name = "default" + , args = defaultArgs + , packages = defaultPackages + , integerLibrary = (\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple + , libraryWays = defaultLibraryWays + , rtsWays = defaultRtsWays + , splitObjects = defaultSplitObjects + , dynamicGhcPrograms = defaultDynamicGhcPrograms + , ghciWithDebugger = False + , ghcProfiled = False + , ghcDebugged = False } + +-- | Default logic for determining whether to build +-- dynamic GHC programs. +-- +-- It corresponds to the DYNAMIC_GHC_PROGRAMS logic implemented +-- in @mk/config.mk.in@. +defaultDynamicGhcPrograms :: Action Bool +defaultDynamicGhcPrograms = do + win <- windowsHost + supportsShared <- platformSupportsSharedLibs + return (not win && supportsShared) + +-- | Default condition for building split objects. +defaultSplitObjects :: Predicate +defaultSplitObjects = do + goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages + pkg <- getPackage + supported <- expr supportsSplitObjects + split <- expr cmdSplitObjects + let goodPackage = isLibrary pkg && pkg /= compiler && pkg /= rts + return $ split && goodStage && goodPackage && supported + +-- | All 'Builder'-dependent command line arguments. +defaultBuilderArgs :: Args +defaultBuilderArgs = mconcat + -- GHC-specific builders: + [ alexBuilderArgs + , cabalBuilderArgs + , ccBuilderArgs + , configureBuilderArgs + , deriveConstantsBuilderArgs + , genPrimopCodeBuilderArgs + , ghcBuilderArgs + , ghcPkgBuilderArgs + , haddockBuilderArgs + , happyBuilderArgs + , hsc2hsBuilderArgs + , hsCppBuilderArgs + , ldBuilderArgs + , makeBuilderArgs + , runTestBuilderArgs + , validateBuilderArgs + , xelatexBuilderArgs + -- Generic builders from the Hadrian library: + , builder (Ar Pack ) ? Hadrian.Builder.Ar.args Pack + , builder (Ar Unpack ) ? Hadrian.Builder.Ar.args Unpack + , builder (Sphinx Html ) ? Hadrian.Builder.Sphinx.args Html + , builder (Sphinx Latex) ? Hadrian.Builder.Sphinx.args Latex + , builder (Sphinx Man ) ? Hadrian.Builder.Sphinx.args Man + , builder (Tar Create ) ? Hadrian.Builder.Tar.args Create + , builder (Tar Extract ) ? Hadrian.Builder.Tar.args Extract ] + +-- | All 'Package'-dependent command line arguments. +defaultPackageArgs :: Args +defaultPackageArgs = mconcat [ packageArgs, warningArgs ] diff --git a/hadrian/src/Settings/Default.hs-boot b/hadrian/src/Settings/Default.hs-boot new file mode 100644 index 0000000000..30a28497e9 --- /dev/null +++ b/hadrian/src/Settings/Default.hs-boot @@ -0,0 +1,21 @@ +module Settings.Default ( + SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, + defaultArgs, defaultLibraryWays, defaultRtsWays, + defaultFlavour, defaultSplitObjects + ) where + +import Flavour +import Expression + +data SourceArgs = SourceArgs + { hsDefault :: Args + , hsLibrary :: Args + , hsCompiler :: Args + , hsGhc :: Args } + +sourceArgs :: SourceArgs -> Args + +defaultBuilderArgs, defaultPackageArgs, defaultArgs :: Args +defaultLibraryWays, defaultRtsWays :: Ways +defaultFlavour :: Flavour +defaultSplitObjects :: Predicate diff --git a/hadrian/src/Settings/Flavours/Common.hs b/hadrian/src/Settings/Flavours/Common.hs new file mode 100644 index 0000000000..a1eb2fbba9 --- /dev/null +++ b/hadrian/src/Settings/Flavours/Common.hs @@ -0,0 +1,11 @@ +module Settings.Flavours.Common where + +import Expression + +-- See https://ghc.haskell.org/trac/ghc/ticket/15286 and +-- https://phabricator.haskell.org/D4880 +naturalInBaseFixArgs :: Args +naturalInBaseFixArgs = mconcat + [ input "//Natural.hs" ? pure ["-fno-omit-interface-pragmas"] + , input "//Num.hs" ? pure ["-fno-ignore-interface-pragmas"] + ] diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs new file mode 100644 index 0000000000..5919026cb0 --- /dev/null +++ b/hadrian/src/Settings/Flavours/Development.hs @@ -0,0 +1,20 @@ +module Settings.Flavours.Development (developmentFlavour) where + +import Expression +import Flavour +import {-# SOURCE #-} Settings.Default + +-- Please update doc/flavours.md when changing this file. +developmentFlavour :: Stage -> Flavour +developmentFlavour ghcStage = defaultFlavour + { name = "devel" ++ show (fromEnum ghcStage) + , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs } + +developmentArgs :: Stage -> Args +developmentArgs ghcStage = do + stage <- getStage + sourceArgs SourceArgs + { hsDefault = pure ["-O", "-H64m"] + , hsLibrary = notStage0 ? arg "-dcore-lint" + , hsCompiler = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"] + , hsGhc = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"] } diff --git a/hadrian/src/Settings/Flavours/Performance.hs b/hadrian/src/Settings/Flavours/Performance.hs new file mode 100644 index 0000000000..64ab4bce9d --- /dev/null +++ b/hadrian/src/Settings/Flavours/Performance.hs @@ -0,0 +1,18 @@ +module Settings.Flavours.Performance (performanceFlavour) where + +import Expression +import Flavour +import {-# SOURCE #-} Settings.Default + +-- Please update doc/flavours.md when changing this file. +performanceFlavour :: Flavour +performanceFlavour = defaultFlavour + { name = "perf" + , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs } + +performanceArgs :: Args +performanceArgs = sourceArgs SourceArgs + { hsDefault = pure ["-O", "-H64m"] + , hsLibrary = notStage0 ? arg "-O2" + , hsCompiler = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] + , hsGhc = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] } diff --git a/hadrian/src/Settings/Flavours/Profiled.hs b/hadrian/src/Settings/Flavours/Profiled.hs new file mode 100644 index 0000000000..91b7f3b188 --- /dev/null +++ b/hadrian/src/Settings/Flavours/Profiled.hs @@ -0,0 +1,23 @@ +module Settings.Flavours.Profiled (profiledFlavour) where + +import Expression +import Flavour +import {-# SOURCE #-} Settings.Default +import Settings.Flavours.Common (naturalInBaseFixArgs) + +-- Please update doc/flavours.md when changing this file. +profiledFlavour :: Flavour +profiledFlavour = defaultFlavour + { name = "prof" + , args = defaultBuilderArgs <> profiledArgs <> defaultPackageArgs + , ghcProfiled = True } + +profiledArgs :: Args +profiledArgs = sourceArgs SourceArgs + { hsDefault = mconcat + [ pure ["-O0", "-H64m"] + , naturalInBaseFixArgs + ] + , hsLibrary = notStage0 ? arg "-O" + , hsCompiler = arg "-O" + , hsGhc = arg "-O" } diff --git a/hadrian/src/Settings/Flavours/Quick.hs b/hadrian/src/Settings/Flavours/Quick.hs new file mode 100644 index 0000000000..59b58eb413 --- /dev/null +++ b/hadrian/src/Settings/Flavours/Quick.hs @@ -0,0 +1,34 @@ +module Settings.Flavours.Quick (quickFlavour) where + +import Expression +import Flavour +import Oracles.Flag +import {-# SOURCE #-} Settings.Default +import Settings.Flavours.Common + +-- Please update doc/flavours.md when changing this file. +quickFlavour :: Flavour +quickFlavour = defaultFlavour + { name = "quick" + , args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs + , libraryWays = mconcat + [ pure [vanilla] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] + , rtsWays = mconcat + [ pure + [ vanilla, threaded, logging, debug + , threadedDebug, threadedLogging, threaded ] + , notStage0 ? platformSupportsSharedLibs ? pure + [ dynamic, debugDynamic, threadedDynamic, loggingDynamic + , threadedDebugDynamic, threadedLoggingDynamic ] + ] } + +quickArgs :: Args +quickArgs = sourceArgs SourceArgs + { hsDefault = mconcat $ + [ pure ["-O0", "-H64m"] + , naturalInBaseFixArgs + ] + , hsLibrary = notStage0 ? arg "-O" + , hsCompiler = stage0 ? arg "-O" + , hsGhc = stage0 ? arg "-O" } diff --git a/hadrian/src/Settings/Flavours/QuickCross.hs b/hadrian/src/Settings/Flavours/QuickCross.hs new file mode 100644 index 0000000000..7572be27d1 --- /dev/null +++ b/hadrian/src/Settings/Flavours/QuickCross.hs @@ -0,0 +1,37 @@ +module Settings.Flavours.QuickCross (quickCrossFlavour) where + +import Expression +import Flavour +import Oracles.Flag +import {-# SOURCE #-} Settings.Default +import Settings.Flavours.Common + +-- Please update doc/flavours.md when changing this file. +quickCrossFlavour :: Flavour +quickCrossFlavour = defaultFlavour + { name = "quick-cross" + , args = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs + , dynamicGhcPrograms = pure False + , libraryWays = mconcat + [ pure [vanilla] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] + , rtsWays = mconcat + [ pure + [ vanilla, threaded, logging, debug + , threadedDebug, threadedLogging, threaded ] + , notStage0 ? platformSupportsSharedLibs ? pure + [ dynamic, debugDynamic, threadedDynamic, loggingDynamic + , threadedDebugDynamic, threadedLoggingDynamic ] + ] } + +quickCrossArgs :: Args +quickCrossArgs = sourceArgs SourceArgs + { hsDefault = mconcat $ + [ pure ["-O0", "-H64m"] + , naturalInBaseFixArgs + ] + , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvm" ] + , hsCompiler = stage0 ? arg "-O" + , hsGhc = mconcat + [ stage0 ? arg "-O" + , stage1 ? mconcat [ arg "-O0", arg "-fllvm" ] ] } diff --git a/hadrian/src/Settings/Flavours/Quickest.hs b/hadrian/src/Settings/Flavours/Quickest.hs new file mode 100644 index 0000000000..3c5f944e7e --- /dev/null +++ b/hadrian/src/Settings/Flavours/Quickest.hs @@ -0,0 +1,24 @@ +module Settings.Flavours.Quickest (quickestFlavour) where + +import Expression +import Flavour +import {-# SOURCE #-} Settings.Default +import Settings.Flavours.Common + +-- Please update doc/flavours.md when changing this file. +quickestFlavour :: Flavour +quickestFlavour = defaultFlavour + { name = "quickest" + , args = defaultBuilderArgs <> quickestArgs <> defaultPackageArgs + , libraryWays = pure [vanilla] + , rtsWays = pure [vanilla, threaded] } + +quickestArgs :: Args +quickestArgs = sourceArgs SourceArgs + { hsDefault = mconcat $ + [ pure ["-O0", "-H64m"] + , naturalInBaseFixArgs + ] + , hsLibrary = mempty + , hsCompiler = stage0 ? arg "-O" + , hsGhc = stage0 ? arg "-O" } diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs new file mode 100644 index 0000000000..4d75e325d4 --- /dev/null +++ b/hadrian/src/Settings/Packages.hs @@ -0,0 +1,361 @@ +module Settings.Packages (packageArgs) where + +import Expression +import Flavour +import Oracles.Setting +import Oracles.Flag +import Packages +import Rules.Gmp +import Settings + +-- | Package-specific command-line arguments. +packageArgs :: Args +packageArgs = do + stage <- getStage + rtsWays <- getRtsWays + path <- getBuildPath + intLib <- getIntegerPackage + compilerPath <- expr $ buildPath (vanillaContext stage compiler) + gmpBuildPath <- expr gmpBuildPath + let includeGmp = "-I" ++ gmpBuildPath -/- "include" + + mconcat + --------------------------------- base --------------------------------- + [ package base ? mconcat + [ builder (Cabal Flags) ? notStage0 ? arg (pkgName intLib) + + -- This fixes the 'unknown symbol stat' issue. + -- See: https://github.com/snowleopard/hadrian/issues/259. + , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] + + ------------------------------ bytestring ------------------------------ + , package bytestring ? + builder (Cabal Flags) ? intLib == integerSimple ? arg "integer-simple" + + --------------------------------- cabal -------------------------------- + -- Cabal is a large library and 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 optimise it. + , package cabal ? + stage0 ? builder Ghc ? arg "-O0" + + ------------------------------- compiler ------------------------------- + , package compiler ? mconcat + [ builder Alex ? arg "--latin1" + + , builder (Ghc CompileHs) ? mconcat + [ inputs ["//GHC.hs", "//GhcMake.hs"] ? arg "-fprof-auto" + , input "//Parser.hs" ? + pure ["-fno-ignore-interface-pragmas", "-fcmm-sink" ] ] + + , builder (Cabal Setup) ? 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" + , (any (wayUnit Threaded) rtsWays) ? + notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" + , 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 (Cabal Flags) ? mconcat + [ ghcWithNativeCodeGen ? arg "ncg" + , ghcWithInterpreter ? notStage0 ? arg "ghci" + , flag CrossCompiling ? arg "-terminfo" + , notStage0 ? intLib == integerGmp ? + arg "integer-gmp" ] + + , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + + ---------------------------------- ghc --------------------------------- + , package ghc ? mconcat + [ builder Ghc ? arg ("-I" ++ compilerPath) + + , builder (Cabal Flags) ? mconcat + [ ghcWithInterpreter ? notStage0 ? arg "ghci" + , flag CrossCompiling ? arg "-terminfo" + -- the 'threaded' flag is True by default, but + -- let's record explicitly that we link all ghc + -- executables with the threaded runtime. + , arg "threaded" ] ] + + -------------------------------- ghcPkg -------------------------------- + , package ghcPkg ? + builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo" + + -------------------------------- ghcPrim ------------------------------- + , package ghcPrim ? mconcat + [ builder (Cabal Flags) ? arg "include-ghc-prim" + + , builder (Cc CompileC) ? (not <$> flag GccIsClang) ? + input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ] + + --------------------------------- ghci --------------------------------- + -- TODO: This should not be @not <$> flag CrossCompiling@. Instead we + -- should ensure that the bootstrap compiler has the same version as the + -- one we are building. + + -- TODO: In that case we also do not need to build most of the Stage1 + -- libraries, as we already know that the compiler comes with the most + -- recent versions. + + -- TODO: The use case here is that we want to build @ghc-proxy@ for the + -- cross compiler. That one needs to be compiled by the bootstrap + -- compiler as it needs to run on the host. Hence @libiserv@ needs + -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci@. And those are + -- behind the @-fghci@ flag. + , package ghci ? mconcat + [ notStage0 ? builder (Cabal Flags) ? arg "ghci" + , flag CrossCompiling ? stage0 ? builder (Cabal Flags) ? arg "ghci" ] + + -------------------------------- haddock ------------------------------- + , package haddock ? + builder (Cabal Flags) ? arg "in-ghc-tree" + + ------------------------------- haskeline ------------------------------ + , package haskeline ? + builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo" + + -------------------------------- hsc2hs -------------------------------- + , package hsc2hs ? + builder (Cabal Flags) ? arg "in-ghc-tree" + + ------------------------------ integerGmp ------------------------------ + , package integerGmp ? mconcat + [ builder Cc ? arg includeGmp + + , builder (Cabal Setup) ? mconcat + [ -- TODO: This should respect some settings flag "InTreeGmp". + -- Depending on @IncludeDir@ and @LibDir@ is bound to fail, since + -- these are only set if the configure script was explicilty + -- called with GMP include and lib dirs. Their absense as such + -- does not imply @in-tree-gmp@. + -- (null gmpIncludeDir && null gmpLibDir) ? + -- arg "--configure-option=--with-intree-gmp" + 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@ + -- or @integer-simple@. For Stage0, we need to use the integer library + -- that the bootstrap compiler has (since @interger@ is not a boot + -- library) and therefore we copy it over into the Stage0 package-db. + -- Maybe we should stop doing this? And subsequently @text@ for Stage1 + -- detects the same integer library again, even though we don't build it + -- in Stage1, and at that point the configuration is just wrong. + , package text ? + builder (Cabal Flags) ? notStage0 ? intLib == integerSimple ? + pure [ "+integer-simple", "-bytestring-builder"] ] + +-- | 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 + 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" ] + , 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 (Cabal Flags) ? mconcat + [ any (wayUnit Profiling) rtsWays ? arg "profiling" + , any (wayUnit Debug) rtsWays ? arg "debug" + , any (wayUnit Logging) rtsWays ? arg "logging" + ] + , 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 ? 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/hadrian/src/Settings/Warnings.hs b/hadrian/src/Settings/Warnings.hs new file mode 100644 index 0000000000..5a9e8311db --- /dev/null +++ b/hadrian/src/Settings/Warnings.hs @@ -0,0 +1,57 @@ +module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where + +import Expression +import Oracles.Flag +import Oracles.Setting +import Packages +import Settings + +-- See @mk/warnings.mk@ for warning-related arguments in the Make build system. + +-- | Default Haskell warning-related arguments. +defaultGhcWarningsArgs :: Args +defaultGhcWarningsArgs = mconcat + [ notStage0 ? arg "-Wnoncanonical-monad-instances" + , (not <$> flag GccIsClang) ? mconcat + [ (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable" + , arg "-optc-Wno-error=inline" ] + , flag GccIsClang ? arg "-optc-Wno-unknown-pragmas" ] + +-- | Package-specific warnings-related arguments, mostly suppressing various warnings. +warningArgs :: Args +warningArgs = builder Ghc ? do + isIntegerSimple <- (== integerSimple) <$> getIntegerPackage + mconcat + [ stage0 ? mconcat + [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ] + , package terminfo ? pure [ "-fno-warn-unused-imports" ] + , package transformers ? pure [ "-fno-warn-unused-matches" + , "-fno-warn-unused-imports" ] ] + , notStage0 ? mconcat + [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] + , package base ? pure [ "-Wno-trustworthy-safe" ] + , package binary ? pure [ "-Wno-deprecations" ] + , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] + , package compiler ? pure [ "-Wcpp-undef" ] + , package directory ? pure [ "-Wno-unused-imports" ] + , package ghc ? pure [ "-Wcpp-undef" ] + , package ghcPrim ? pure [ "-Wno-trustworthy-safe" ] + , package haddock ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package haskeline ? pure [ "-Wno-deprecations" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-simplifiable-class-constraints" ] + , package pretty ? pure [ "-Wno-unused-imports" ] + , package primitive ? pure [ "-Wno-unused-imports" + , "-Wno-deprecations" ] + , package rts ? pure [ "-Wcpp-undef" ] + , package terminfo ? pure [ "-Wno-unused-imports" ] + , isIntegerSimple ? + package text ? pure [ "-Wno-unused-imports" ] + , package transformers ? pure [ "-Wno-unused-matches" + , "-Wno-unused-imports" + , "-Wno-redundant-constraints" + , "-Wno-orphans" ] + , package win32 ? pure [ "-Wno-trustworthy-safe" ] + , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] |