From c866660513a23723209a81f07b1b859265fe33bf Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Thu, 14 Jun 2018 01:43:31 +0100 Subject: [PATCH] Minor revision (#619) See #540 --- src/GHC.hs | 20 +- src/Hadrian/Haskell/Cabal/PackageData.hs | 69 +++--- src/Hadrian/Haskell/Cabal/Parse.hs | 125 +++++------ src/Oracles/Flag.hs | 10 +- src/Rules/Generate.hs | 6 +- src/Rules/Program.hs | 4 +- src/Settings/Builders/GhcCabal.hs | 5 +- src/Settings/Builders/Hsc2Hs.hs | 4 +- src/Settings/Builders/RunTest.hs | 12 +- src/Settings/Packages.hs | 263 +++++++++++++---------- src/Settings/Packages/Compiler.hs | 2 +- 11 files changed, 280 insertions(+), 240 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 9a270db3f0..d286ccbb7e 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -1,14 +1,14 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module GHC ( -- * GHC packages - array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr, + array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr, compareSizes, compiler, containers, deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, - ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, - haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, - libffi, libiserv, mtl, parsec, parallel, pretty, primitive, process, rts, - runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers, - unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages, + ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, + haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, + libffi, libiserv, mtl, parsec, parallel, pretty, primitive, process, rts, + runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers, + unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages, testsuitePackages, -- * Package information @@ -36,7 +36,7 @@ defaultPackages Stage3 = return [] stage0Packages :: Action [Package] stage0Packages = do win <- windowsHost - cross <- crossCompiling + cross <- flag CrossCompiling return $ [ binary , cabal , compareSizes @@ -68,7 +68,7 @@ stage1Packages = do win <- windowsHost intLib <- integerLibrary =<< flavour libraries0 <- filter isLibrary <$> stage0Packages - cross <- crossCompiling + cross <- flag CrossCompiling return $ libraries0 -- Build all Stage0 libraries in Stage1 ++ [ array , base @@ -106,7 +106,7 @@ stage2Packages = return [haddock] testsuitePackages :: Action [Package] testsuitePackages = return [ checkApiAnnotations , checkPpr - , hp2ps ] + , hp2ps ] -- | Given a 'Context', compute the name of the program that is built in it -- assuming that the corresponding package's type is 'Program'. For example, GHC @@ -114,7 +114,7 @@ testsuitePackages = return [ checkApiAnnotations -- 'Library', the function simply returns its name. programName :: Context -> Action String programName Context {..} = do - cross <- crossCompiling + cross <- flag CrossCompiling targetPlatform <- setting TargetPlatformFull let prefix = if cross then targetPlatform ++ "-" else "" in return $ prefix ++ case package of diff --git a/src/Hadrian/Haskell/Cabal/PackageData.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs index 9bbebcf9d8..d4cd41a135 100644 --- a/src/Hadrian/Haskell/Cabal/PackageData.hs +++ b/src/Hadrian/Haskell/Cabal/PackageData.hs @@ -4,43 +4,42 @@ import Development.Shake.Classes import Hadrian.Package.Type import GHC.Generics +-- | Most of these fields used to be provided in @package-data.mk@ files. data PackageData = PackageData - { dependencies :: [PackageName] - , name :: PackageName - , version :: String - -- * used to be pkg Data - , componentId :: String - , modules :: [String] - , otherModules :: [String] - , synopsis :: String - , description :: String - , srcDirs :: [String] - , deps :: [String] - , depIpIds :: [String] - , depNames :: [String] - , depCompIds :: [String] - , includeDirs :: [String] - , includes :: [String] + { dependencies :: [PackageName] + , name :: PackageName + , version :: String + , componentId :: String + , modules :: [String] + , otherModules :: [String] + , synopsis :: String + , description :: String + , srcDirs :: [String] + , deps :: [String] + , depIpIds :: [String] + , depNames :: [String] + , depCompIds :: [String] + , includeDirs :: [String] + , includes :: [String] , installIncludes :: [String] - , extraLibs :: [String] - , extraLibDirs :: [String] - , asmSrcs :: [String] - , cSrcs :: [String] - , cmmSrcs :: [String] - , dataFiles :: [String] - , hcOpts :: [String] - , asmOpts :: [String] - , ccOpts :: [String] - , cmmOpts :: [String] - , cppOpts :: [String] - , ldOpts :: [String] - , depIncludeDirs :: [String] - , depCcOpts :: [String] - , depLdOpts :: [String] - , buildGhciLib :: Bool + , extraLibs :: [String] + , extraLibDirs :: [String] + , asmSrcs :: [String] + , cSrcs :: [String] + , cmmSrcs :: [String] + , dataFiles :: [String] + , hcOpts :: [String] + , asmOpts :: [String] + , ccOpts :: [String] + , cmmOpts :: [String] + , cppOpts :: [String] + , ldOpts :: [String] + , depIncludeDirs :: [String] + , depCcOpts :: [String] + , depLdOpts :: [String] + , buildGhciLib :: Bool } deriving (Eq, Read, Show, Typeable, Generic) -instance Binary PackageData - +instance Binary PackageData instance Hashable PackageData -instance NFData PackageData +instance NFData PackageData diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index a36e25d6b2..9e6b875236 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -147,12 +147,12 @@ configurePackage context@Context {..} = do pure $ C.simpleUserHooks { C.postConf = \_ _ _ _ -> return () } | otherwise -> pure C.simpleUserHooks + -- Compute the list of flags + -- Compute the Cabal configurartion arguments flavourArgs <- args <$> flavour - -- Compute the list of flags. - flagList <- interpret (target context (CabalFlags stage) [] []) flavourArgs - -- Compute the Cabal configurartion arguments. - argList <- interpret (target context (GhcCabal Conf stage) [] []) flavourArgs - verbosity <- getVerbosity + flagList <- interpret (target context (CabalFlags stage) [] []) flavourArgs + argList <- interpret (target context (GhcCabal Conf stage) [] []) flavourArgs + verbosity <- getVerbosity let v = if verbosity >= Loud then "-v3" else "-v0" liftIO $ C.defaultMainWithHooksNoReadArgs hooks gpd (argList ++ ["--flags=" ++ unwords flagList, v]) @@ -184,10 +184,10 @@ registerPackage context@Context {..} = do -- | Parse the 'PackageData' of the 'Package' of a given 'Context'. parsePackageData :: Context -> Action PackageData parsePackageData context@Context {..} = do - -- XXX: This is conceptually wrong! - -- We should use the gpd, the flagAssignment and compiler, hostPlatform, ... - -- information from the lbi. And then compute the finalised PD (flags, - -- satisfiable dependencies, platform, compiler info, deps, gpd.) + -- TODO: This is conceptually wrong! + -- We should use the gpd, the flagAssignment and compiler, hostPlatform, and + -- other information from the lbi. And then compute the finalised PD (flags, + -- satisfiable dependencies, platform, compiler info, deps, gpd). -- -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd -- @@ -199,7 +199,7 @@ parsePackageData context@Context {..} = do lbi <- liftIO $ C.getPersistBuildConfig cPath - -- XXX: move this into its own rule for "build/autogen/cabal_macros.h", and + -- TODO: Move this into its own rule for "build/autogen/cabal_macros.h", and -- "build/autogen/Path_*.hs" and 'need' them here. -- create the cabal_macros.h, ... -- Note: the `cPath` is ignored. The path that's used is the 'buildDir' path @@ -211,26 +211,25 @@ parsePackageData context@Context {..} = do -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 - let extDeps = C.externalPackageDeps lbi' - deps = map (C.display . snd) extDeps - dep_direct = map (fromMaybe (error "dep_keys failed") - . C.lookupUnitId (C.installedPkgs lbi') - . fst) extDeps - dep_ipids = map (C.display . Installed.installedUnitId) dep_direct - + let extDeps = C.externalPackageDeps lbi' + deps = map (C.display . snd) extDeps + dep_direct = map (fromMaybe (error "parsePackageData: dep_keys failed") + . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps + dep_ipids = map (C.display . Installed.installedUnitId) dep_direct Just ghcProg = C.lookupProgram C.ghcProgram (C.withPrograms lbi') - - dep_pkgs = C.topologicalOrder (packageHacks (C.installedPkgs lbi')) - forDeps f = concatMap f dep_pkgs + dep_pkgs = C.topologicalOrder (packageHacks (C.installedPkgs lbi')) + forDeps f = concatMap f dep_pkgs -- Copied from Distribution.Simple.PreProcess.ppHsc2Hs packageHacks = case C.compilerFlavor (C.compiler lbi') of C.GHC | C.pkgName (C.package pd') /= (C.mkPackageName "rts") -> hackRtsPackage _ -> id + + -- TODO: Get rid of this hack. -- We don't link in the actual Haskell libraries of our dependencies, so - -- the -u flags in the ldOptions of the rts package mean linking fails - -- on OS X (it's ld is a tad stricter than gnu ld). Thus we remove the - -- ldOptions for GHC's rts package: + -- the "-u" flags in @ldOptions@ of the @rts@ package mean linking fails + -- on OS X (its @ld@ is a tad stricter than GNU @ld@). Thus we remove + -- @ldOptions@ for the @rts@ package. With one exception (see below). hackRtsPackage index | null (C.allPackages index) = index -- ^ do not hack the empty index hackRtsPackage index = case C.lookupPackageName index (C.mkPackageName "rts") of @@ -244,50 +243,52 @@ parsePackageData context@Context {..} = do -- there. So we filter out gcc-lib from the RTS's library-dirs here. _ -> error "No (or multiple) GHC rts package is registered!" + buildInfo = fst (biModules pd') + in return $ PackageData - { dependencies = deps - , name = C.unPackageName . C.pkgName . C.package $ pd' - , version = C.display . C.pkgVersion . C.package $ pd' - , componentId = C.localCompatPackageKey lbi' - , modules = map C.display . snd . biModules $ pd' - , otherModules = map C.display . C.otherModules . fst . biModules $ pd' - , synopsis = C.synopsis pd' - , description = C.description pd' - , srcDirs = C.hsSourceDirs . fst . biModules $ pd' - , deps = deps - , depIpIds = dep_ipids - , depNames = map (C.display . C.mungedName . snd) extDeps - , depCompIds = if C.packageKeySupported (C.compiler lbi') - then dep_ipids - else deps - , includeDirs = C.includeDirs . fst . biModules $ pd' - , includes = C.includes . fst . biModules $ pd' - , installIncludes = C.installIncludes . fst . biModules $ pd' - , extraLibs = C.extraLibs . fst . biModules $ pd' - , extraLibDirs = C.extraLibDirs . fst . biModules $ pd' - , asmSrcs = C.asmSources . fst . biModules $ pd' - , cSrcs = C.cSources . fst . biModules $ pd' - , cmmSrcs = C.cmmSources . fst . biModules $ pd' - , dataFiles = C.dataFiles pd' - , hcOpts = C.programDefaultArgs ghcProg - ++ (C.hcOptions C.GHC . fst . biModules $ pd') - ++ C.languageToFlags (C.compiler lbi') (C.defaultLanguage . fst $ biModules pd') - ++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions . fst $ biModules pd') + { dependencies = deps + , name = C.unPackageName . C.pkgName . C.package $ pd' + , version = C.display . C.pkgVersion . C.package $ pd' + , componentId = C.localCompatPackageKey lbi' + , modules = map C.display . snd . biModules $ pd' + , otherModules = map C.display . C.otherModules $ buildInfo + , synopsis = C.synopsis pd' + , description = C.description pd' + , srcDirs = C.hsSourceDirs buildInfo + , deps = deps + , depIpIds = dep_ipids + , depNames = map (C.display . C.mungedName . snd) extDeps + , depCompIds = if C.packageKeySupported (C.compiler lbi') + then dep_ipids + else deps + , includeDirs = C.includeDirs buildInfo + , includes = C.includes buildInfo + , installIncludes = C.installIncludes buildInfo + , extraLibs = C.extraLibs buildInfo + , extraLibDirs = C.extraLibDirs buildInfo + , asmSrcs = C.asmSources buildInfo + , cSrcs = C.cSources buildInfo + , cmmSrcs = C.cmmSources buildInfo + , dataFiles = C.dataFiles pd' + , hcOpts = C.programDefaultArgs ghcProg + ++ C.hcOptions C.GHC buildInfo + ++ C.languageToFlags (C.compiler lbi') (C.defaultLanguage buildInfo) + ++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions buildInfo) ++ C.programOverrideArgs ghcProg - , asmOpts = C.asmOptions . fst $ biModules pd' - , ccOpts = C.ccOptions . fst $ biModules pd' - , cmmOpts = C.cmmOptions . fst $ biModules pd' - , cppOpts = C.cppOptions . fst $ biModules pd' - , ldOpts = C.ldOptions . fst $ biModules pd' - , depIncludeDirs = forDeps Installed.includeDirs - , depCcOpts = forDeps Installed.ccOptions - , depLdOpts = forDeps Installed.ldOptions - , buildGhciLib = C.withGHCiLib lbi' } + , asmOpts = C.asmOptions buildInfo + , ccOpts = C.ccOptions buildInfo + , cmmOpts = C.cmmOptions buildInfo + , cppOpts = C.cppOptions buildInfo + , ldOpts = C.ldOptions buildInfo + , depIncludeDirs = forDeps Installed.includeDirs + , depCcOpts = forDeps Installed.ccOptions + , depLdOpts = forDeps Installed.ldOptions + , buildGhciLib = C.withGHCiLib lbi' } getHookedBuildInfo :: FilePath -> IO C.HookedBuildInfo getHookedBuildInfo baseDir = do - -- TODO: We should probably better generate this in the build dir, rather then - -- in the base dir? However `configure` is run in the baseDir. + -- TODO: We should probably better generate this in the build dir, rather + -- than in the base dir? However, @configure@ is run in the baseDir. maybeInfoFile <- C.findHookedPackageDesc baseDir case maybeInfoFile of Nothing -> return C.emptyHookedBuildInfo diff --git a/src/Oracles/Flag.hs b/src/Oracles/Flag.hs index 1bd4dfeefd..57dbf2decb 100644 --- a/src/Oracles/Flag.hs +++ b/src/Oracles/Flag.hs @@ -1,9 +1,10 @@ module Oracles.Flag ( - Flag (..), flag, crossCompiling, platformSupportsSharedLibs, - ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects + Flag (..), flag, getFlag, platformSupportsSharedLibs, ghcWithSMP, + ghcWithNativeCodeGen, supportsSplitObjects ) where import Hadrian.Oracles.TextFile +import Hadrian.Expression import Base import Oracles.Setting @@ -39,8 +40,9 @@ flag f = do ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." return $ value == "YES" -crossCompiling :: Action Bool -crossCompiling = flag CrossCompiling +-- | Get a configuration setting. +getFlag :: Flag -> Expr c b Bool +getFlag = expr . flag platformSupportsSharedLibs :: Action Bool platformSupportsSharedLibs = do diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 8355ccc0a9..e26e811fe8 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -239,7 +239,7 @@ generateGhcPlatformH = do targetArch <- getSetting TargetArch targetOs <- getSetting TargetOs targetVendor <- getSetting TargetVendor - ghcUnreg <- expr $ flag GhcUnregisterised + ghcUnreg <- getFlag GhcUnregisterised return . unlines $ [ "#ifndef __GHCPLATFORM_H__" , "#define __GHCPLATFORM_H__" @@ -305,7 +305,7 @@ generateConfigHs = do cGHC_UNLIT_PGM <- fmap takeFileName $ getBuilderPath Unlit cLibFFI <- expr useLibFFIForAdjustors rtsWays <- getRtsWays - cGhcRtsWithLibdw <- expr $ flag WithLibdw + cGhcRtsWithLibdw <- getFlag WithLibdw let cGhcRTSWays = unwords $ map show rtsWays return $ unlines [ "{-# LANGUAGE CPP #-}" @@ -381,7 +381,7 @@ generateGhcAutoconfH = do trackGenerateHs configHContents <- expr $ map undefinePackage <$> readFileLines configH tablesNextToCode <- expr ghcEnableTablesNextToCode - ghcUnreg <- expr $ flag GhcUnregisterised + ghcUnreg <- getFlag GhcUnregisterised ccLlvmBackend <- getSetting CcLlvmBackend ccClangBackend <- getSetting CcClangBackend return . unlines $ diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 083f3cd354..7b137f0d4e 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -7,8 +7,8 @@ import Base import Context import Expression hiding (stage, way) import GHC +import Oracles.Flag import Oracles.ModuleFiles -import Oracles.Flag (crossCompiling) import Settings import Settings.Packages.Rts import Target @@ -49,7 +49,7 @@ buildProgram rs = do -- @llvm-passes@. need =<< ghcDeps stage - cross <- crossCompiling + cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/@ to @stage1/bin/@. case (cross, stage) of (True, s) | s > Stage0 -> do diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index d656039fb1..9aa7738fea 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -25,7 +25,8 @@ ghcCabalBuilderArgs = mconcat -- 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. - , crossCompiling ? pure [ "--disable-executable-stripping", "--disable-library-stripping" ] + , flag CrossCompiling ? pure [ "--disable-executable-stripping" + , "--disable-library-stripping" ] , arg "--cabal-file" , arg =<< fromJust . pkgCabalFile <$> getPackage , arg "--distdir" @@ -103,7 +104,7 @@ configureArgs = do , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir , conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir - , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) + , flag CrossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 3a8094089a..2c9194aeb1 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -22,11 +22,11 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do tmpl <- (top -/-) <$> expr (templateHscPath Stage0) mconcat [ arg $ "--cc=" ++ ccPath , arg $ "--ld=" ++ ccPath - , notM windowsHost ? notM crossCompiling ? arg "--cross-safe" + , notM windowsHost ? notM (flag CrossCompiling) ? arg "--cross-safe" , pure $ map ("-I" ++) (words gmpDir) , map ("--cflag=" ++) <$> getCFlags , map ("--lflag=" ++) <$> getLFlags - , notStage0 ? crossCompiling ? arg "--cross-compile" + , 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") diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 6e1c5d1b59..f8d2705a69 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -21,7 +21,7 @@ runTestBuilderArgs = builder RunTest ? do withNativeCodeGen <- expr ghcWithNativeCodeGen withInterpreter <- expr ghcWithInterpreter - unregisterised <- expr $ flag GhcUnregisterised + unregisterised <- getFlag GhcUnregisterised withSMP <- expr ghcWithSMP windows <- expr windowsHost @@ -78,8 +78,8 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.wordsize=\"64\"" , arg "-e", arg $ "config.os=" ++ show os , arg "-e", arg $ "config.arch=" ++ show arch - , arg "-e", arg $ "config.platform=" ++ show platform - + , arg "-e", arg $ "config.platform=" ++ show platform + , arg "--config-file=testsuite/config/ghc" , arg "--config", arg $ "compiler=" ++ show (top -/- compiler) , arg "--config", arg $ "ghc_pkg=" ++ show (top -/- ghcPkg) @@ -117,11 +117,11 @@ getTestArgs = do verbosityArg = case testVerbosity args of Nothing -> Nothing Just verbosity -> Just $ "--verbose=" ++ verbosity - wayArgs = map ("--way=" ++) (testWays args) + wayArgs = map ("--way=" ++) (testWays args) pure $ testOnlyArg - ++ speedArg + ++ speedArg ++ catMaybes [ onlyPerfArg, skipPerfArg, summaryArg - , junitArg, verbosityArg ] + , junitArg, verbosityArg ] ++ configArgs ++ wayArgs diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 8081466b37..b221031100 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -8,118 +8,155 @@ import Oracles.Flag import Rules.Gmp import Settings +-- TODO: Finish migration of package-specific settings into a single file. packageArgs :: Args packageArgs = do - intLibPkg <- getIntegerPackage - integerLibraryName <- pkgName <$> getIntegerPackage - - stage <- getStage - rtsWays <- getRtsWays - path <- getBuildPath - - compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler) - - gmpBuildPath <- expr gmpBuildPath - let includeGmp = "-I" ++ gmpBuildPath -/- "include" - - mconcat - [ package base - ? mconcat [ builder CabalFlags ? arg ('+':integerLibraryName) - -- This fixes the 'unknown symbol stat' issue. - -- See: https://github.com/snowleopard/hadrian/issues/259. - , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] - , package bytestring - ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple" - , package text - -- text is rather tricky. It's a boot lib, and it tries to determine on - -- it's 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. (the interger-lib is not a boot lib) but as such, we'll - -- copy it over into the stage0 package-db (maybe we should stop doing this?) - -- And subsequently text for stage1 will detect the same integer lib again, - -- even though we don't build it in stage1, and at that point the - -- configuration is just wrong. - ? builder CabalFlags ? notStage0 ? intLibPkg == integerSimple ? pure [ "+integer-simple" - , "-bytestring-builder"] - , 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" - , package compiler - ? 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 Conf) ? 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 CabalFlags ? mconcat - [ ghcWithNativeCodeGen ? arg "ncg" - , ghcWithInterpreter ? - notStage0 ? arg "ghci" - , crossCompiling ? arg "-terminfo" - ] - , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] - , package ghc - ? mconcat [ builder Ghc ? arg ("-I" ++ compilerBuildPath) - , builder CabalFlags ? ghcWithInterpreter ? notStage0 ? arg "ghci" - , builder CabalFlags ? crossCompiling ? arg "-terminfo" ] - , package ghcPkg - ? builder CabalFlags ? crossCompiling ? arg "-terminfo" - , package ghcPrim - ? mconcat [ builder CabalFlags ? arg "include-ghc-prim" - , builder (Cc CompileC) ? - (not <$> flag GccIsClang) ? - input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ] - -- XXX: This should not be *not <$> crossCompiling*, but ensure - -- that the bootstrap compiler has the same version as the - -- one we are building. - -- XXX: 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. - -- XXX: 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. and as - -- such libiserv needs GHCi.TH, GHCi.Message and GHCi.Run from - -- ghci. And those are beind the -fghci flag. - , package ghci ? notStage0 ? builder CabalFlags ? arg "ghci" - , package ghci ? crossCompiling ? stage0 ? builder CabalFlags ? arg "ghci" - , package haddock ? builder CabalFlags ? arg "in-ghc-tree" - , package haskeline ? builder CabalFlags ? crossCompiling ? arg "-terminfo" - , package hsc2hs ? builder CabalFlags ? arg "in-ghc-tree" - , package integerGmp - ? mconcat [ builder Cc ? arg includeGmp - , builder (GhcCabal Conf) ? mconcat - [ -- (null gmpIncludeDir && null gmpLibDir) ? - -- XXX: this should respect some settings flag "InTreeGmp". - -- depending on include and lib dir, is bound to fail - -- these are only set if ./configure was explicilty - -- called with gmp include and lib dirs. Their absense - -- as such does not imply in-tree-gmp - -- arg "--configure-option=--with-intree-gmp" - arg ("--configure-option=CFLAGS=" ++ includeGmp) - , arg ("--gcc-options=" ++ includeGmp) ] ] - , package runGhc - ? builder Ghc - ? input "//Main.hs" - ? (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion - , package rts - ? builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" - ] + intLib <- getIntegerPackage + stage <- getStage + rtsWays <- getRtsWays + path <- getBuildPath + compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler) + gmpBuildPath <- expr gmpBuildPath + + let includeGmp = "-I" ++ gmpBuildPath -/- "include" + + mconcat + --------------------------------- base --------------------------------- + [ package base ? mconcat + [ builder CabalFlags ? 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 CabalFlags ? 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 ["-O0", "-fno-ignore-interface-pragmas", "-fcmm-sink" ] ] + + , builder (GhcCabal Conf) ? 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 CabalFlags ? mconcat + [ ghcWithNativeCodeGen ? arg "ncg" + , ghcWithInterpreter ? notStage0 ? arg "ghci" + , flag CrossCompiling ? arg "-terminfo" ] + + , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + + ---------------------------------- ghc --------------------------------- + , package ghc ? mconcat + [ builder Ghc ? arg ("-I" ++ compilerBuildPath) + + , builder CabalFlags ? mconcat + [ ghcWithInterpreter ? notStage0 ? arg "ghci" + , flag CrossCompiling ? arg "-terminfo" ] ] + + -------------------------------- ghcPkg -------------------------------- + , package ghcPkg ? + builder CabalFlags ? flag CrossCompiling ? arg "-terminfo" + + -------------------------------- ghcPrim ------------------------------- + , package ghcPrim ? mconcat + [ builder CabalFlags ? 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 CabalFlags ? arg "ghci" + , flag CrossCompiling ? stage0 ? builder CabalFlags ? arg "ghci" ] + + -------------------------------- haddock ------------------------------- + , package haddock ? + builder CabalFlags ? arg "in-ghc-tree" + + ------------------------------- haskeline ------------------------------ + , package haskeline ? + builder CabalFlags ? flag CrossCompiling ? arg "-terminfo" + + -------------------------------- hsc2hs -------------------------------- + , package hsc2hs ? + builder CabalFlags ? arg "in-ghc-tree" + + ------------------------------ integerGmp ------------------------------ + , package integerGmp ? mconcat + [ builder Cc ? arg includeGmp + + , builder (GhcCabal Conf) ? 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) ] ] + + --------------------------------- 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 CabalFlags ? notStage0 ? intLib == integerSimple ? + pure [ "+integer-simple", "-bytestring-builder"] + + -------------------------------- runGhc -------------------------------- + , package runGhc ? + builder Ghc ? input "//Main.hs" ? + (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion + + ---------------------------------- rts --------------------------------- + , package rts ? + builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" ] diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs index 6b329d7b4f..77692fae7c 100644 --- a/src/Settings/Packages/Compiler.hs +++ b/src/Settings/Packages/Compiler.hs @@ -31,7 +31,7 @@ compilerPackageArgs = package compiler ? do , ghcWithNativeCodeGen ? arg "--flags=ncg" , ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" - , crossCompiling ? arg "-f-terminfo" + , flag CrossCompiling ? arg "-f-terminfo" , ghcWithInterpreter ? ghcEnableTablesNextToCode ? notM (flag GhcUnregisterised) ? -- GitLab