From 4aec4b5b0585a08665575e92e38f54c47545cbef Mon Sep 17 00:00:00 2001 From: Rodrigo Mesquita Date: Thu, 11 Jan 2024 22:34:15 +0000 Subject: [PATCH] Format --- Cabal/src/Distribution/Simple/Build/Monad.hs | 10 +- Cabal/src/Distribution/Simple/GHC.hs | 28 +- Cabal/src/Distribution/Simple/GHC/Build.hs | 84 ++--- .../Simple/GHC/Build/ExtraSources.hs | 66 ++-- .../src/Distribution/Simple/GHC/Build/Link.hs | 302 +++++++-------- .../Distribution/Simple/GHC/Build/Modules.hs | 350 +++++++++--------- Cabal/src/Distribution/Simple/GHC/Internal.hs | 149 ++++---- 7 files changed, 496 insertions(+), 493 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Build/Monad.hs b/Cabal/src/Distribution/Simple/Build/Monad.hs index 82816b1e2b4..7aab514dfdf 100644 --- a/Cabal/src/Distribution/Simple/Build/Monad.hs +++ b/Cabal/src/Distribution/Simple/Build/Monad.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE NamedFieldPuns #-} + module Distribution.Simple.Build.Monad ( BuildM (..) , runBuildM @@ -26,14 +27,14 @@ where import Control.Monad.Reader +import Distribution.Simple.Compiler import Distribution.Simple.Setup (BuildingWhat (..), buildingWhatDistPref, buildingWhatVerbosity) +import Distribution.Types.BuildInfo +import Distribution.Types.Component +import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.LocalBuildInfo import Distribution.Types.TargetInfo import Distribution.Verbosity -import Distribution.Types.Component -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.BuildInfo -import Distribution.Simple.Compiler -- | The information required for a build computation (@'BuildM'@) -- which is available right before building each component, i.e. the pre-build @@ -96,4 +97,3 @@ buildCompiler = compiler <$> buildLBI buildTarget :: BuildM TargetInfo buildTarget = asks targetInfo {-# INLINE buildTarget #-} - diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 2fee627039e..20d6d142329 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -89,12 +89,12 @@ import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo import Distribution.Package import Distribution.PackageDescription as PD import Distribution.Pretty +import Distribution.Simple.Build.Monad (runBuildM) import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors import Distribution.Simple.Flag (Flag (..), toFlag) import qualified Distribution.Simple.GHC.Build as GHC -import Distribution.Simple.Build.Monad (runBuildM) import Distribution.Simple.GHC.Build.Utils import Distribution.Simple.GHC.EnvironmentParser import Distribution.Simple.GHC.ImplInfo @@ -104,7 +104,6 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.Program import Distribution.Simple.Program.Builtin (runghcProgram) -import Distribution.Types.TargetInfo import Distribution.Simple.Program.GHC import qualified Distribution.Simple.Program.HcPkg as HcPkg import qualified Distribution.Simple.Program.Strip as Strip @@ -114,6 +113,7 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ParStrat +import Distribution.Types.TargetInfo import Distribution.Utils.NubList import Distribution.Verbosity import Distribution.Version @@ -566,8 +566,8 @@ buildLib -> Library -> ComponentLocalBuildInfo -> IO () -buildLib flags numJobs pkg lbi lib clbi - = runBuildM (BuildNormal flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg) +buildLib flags numJobs pkg lbi lib clbi = + runBuildM (BuildNormal flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg) replLib :: ReplFlags @@ -577,8 +577,8 @@ replLib -> Library -> ComponentLocalBuildInfo -> IO () -replLib flags numJobs pkg lbi lib clbi - = runBuildM (BuildRepl flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg) +replLib flags numJobs pkg lbi lib clbi = + runBuildM (BuildRepl flags) lbi (TargetInfo clbi (CLib lib)) (GHC.build numJobs pkg) -- | Start a REPL without loading any source files. startInterpreter @@ -610,8 +610,8 @@ buildFLib -> ForeignLib -> ComponentLocalBuildInfo -> IO () -buildFLib v njobs pkg lbi flib clbi - = runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg) +buildFLib v njobs pkg lbi flib clbi = + runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg) replFLib :: ReplFlags @@ -621,8 +621,8 @@ replFLib -> ForeignLib -> ComponentLocalBuildInfo -> IO () -replFLib replFlags njobs pkg lbi flib clbi - = runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg) +replFLib replFlags njobs pkg lbi flib clbi = + runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib)) (GHC.build njobs pkg) -- | Build an executable with GHC. buildExe @@ -633,8 +633,8 @@ buildExe -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe v njobs pkg lbi exe clbi - = runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg) +buildExe v njobs pkg lbi exe clbi = + runBuildM (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg) replExe :: ReplFlags @@ -644,8 +644,8 @@ replExe -> Executable -> ComponentLocalBuildInfo -> IO () -replExe replFlags njobs pkg lbi exe clbi - = runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg) +replExe replFlags njobs pkg lbi exe clbi = + runBuildM (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe)) (GHC.build njobs pkg) -- | Extracts a String representing a hash of the ABI of a built -- library. It can fail if the library has not yet been built. diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs index 1b9eb60e346..e40a1b4cb85 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build.hs @@ -1,24 +1,25 @@ {-# LANGUAGE BlockArguments #-} + module Distribution.Simple.GHC.Build where import Distribution.Compat.Prelude import Prelude () -import Data.Function import Control.Monad.IO.Class +import Data.Function +import qualified Data.Set as Set import Distribution.PackageDescription as PD hiding (buildInfo) +import Distribution.Simple.Build.Monad import Distribution.Simple.Flag (Flag) +import Distribution.Simple.GHC.Build.ExtraSources +import Distribution.Simple.GHC.Build.Link +import Distribution.Simple.GHC.Build.Modules import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Utils +import Distribution.Types.ParStrat import System.Directory hiding (exeExtension) import System.FilePath -import Distribution.Simple.Build.Monad -import Distribution.Simple.GHC.Build.ExtraSources -import Distribution.Simple.GHC.Build.Modules -import Distribution.Simple.GHC.Build.Link -import Distribution.Types.ParStrat -import qualified Data.Set as Set {- Note [Build Target Dir vs Target Dir] @@ -26,10 +27,10 @@ Note [Build Target Dir vs Target Dir] Where to place the build result (targetDir) and the build artifacts (buildTargetDir). -* For libraries, targetDir == buildTargetDir, where both the library and +\* For libraries, targetDir == buildTargetDir, where both the library and artifacts are put together. -* For executables or foreign libs, buildTargetDir == targetDir/-tmp, where +\* For executables or foreign libs, buildTargetDir == targetDir/-tmp, where the targetDir is the location where the target (e.g. the executable) is written to and buildTargetDir is where the compilation artifacts (e.g. Main.o) will live Arguably, this difference should not exist (#9498) (TODO) @@ -52,28 +53,28 @@ prefixes. To minimize the likelihood, we use -- | The main build phase of building a component. -- Includes building Haskell modules, extra build sources, and linking. -build :: Flag ParStrat - -> PackageDescription - -> BuildM () +build + :: Flag ParStrat + -> PackageDescription + -> BuildM () build numJobs pkg_descr = do verbosity <- buildVerbosity component <- buildComponent - lbi <- buildLBI - clbi <- buildCLBI + lbi <- buildLBI + clbi <- buildCLBI - let isLib | CLib{} <- component = True - | otherwise = False + let isLib + | CLib{} <- component = True + | otherwise = False -- See Note [Build Target Dir vs Target Dir] let targetDir_absolute = componentBuildDir lbi clbi buildTargetDir_absolute -- Libraries use the target dir for building (see above) | isLib = targetDir_absolute - -- In other cases, use targetDir/-tmp - | targetDirName:_ <- reverse $ splitDirectories targetDir_absolute - = targetDir_absolute (targetDirName ++ "-tmp") - + | targetDirName : _ <- reverse $ splitDirectories targetDir_absolute = + targetDir_absolute (targetDirName ++ "-tmp") | otherwise = error "GHC.build: targetDir is empty" liftIO do @@ -87,28 +88,28 @@ build numJobs pkg_descr = do let -- wantVanilla is underspecified, maybe we could deprecated it? (TODO) wantVanilla = if isLib then withVanillaLib lbi else False - wantStatic = if isLib then withStaticLib lbi else withFullyStaticExe lbi + wantStatic = if isLib then withStaticLib lbi else withFullyStaticExe lbi wantDynamic = if isLib then withSharedLib lbi else withDynExe lbi - wantProf = if isLib then withProfLib lbi else withProfExe lbi + wantProf = if isLib then withProfLib lbi else withProfExe lbi -- See also Note [Building Haskell Modules accounting for TH] in Distribution.Simple.GHC.Build.Modules - wantedWays - = Set.fromList - $ [StaticWay | wantStatic] - <> [DynWay | wantDynamic ] - <> [ProfWay | wantProf ] - -- If no way is explicitly wanted, we take vanilla - <> [VanillaWay | wantVanilla || not (wantStatic || wantDynamic || wantProf) ] - -- ROMES:TODO: Is vanilla necessarily the same as defaultGhcWay? If so, - -- we can deal away with VanillaWay and be explicit in -dynamic vs - -- -static, or always default to -static. Would simplify further. - -- ROMES:TODO: Perhaps, if the component is indefinite, we only pick Vanilla? - -- To mimick the old behaviour we need at least profiled too (Vanilla + - -- Prof), and there's even a test for profiled signature, whatever that - -- means. So only doing vanilla way for indefinite components before seems wrong. - -- Consider... - -- ROMES:TODO: Perhaps for executables we want to limit the "wanted" - -- ways to just one? + wantedWays = + Set.fromList $ + [StaticWay | wantStatic] + <> [DynWay | wantDynamic] + <> [ProfWay | wantProf] + -- If no way is explicitly wanted, we take vanilla + <> [VanillaWay | wantVanilla || not (wantStatic || wantDynamic || wantProf)] + -- ROMES:TODO: Is vanilla necessarily the same as defaultGhcWay? If so, + -- we can deal away with VanillaWay and be explicit in -dynamic vs + -- -static, or always default to -static. Would simplify further. + -- ROMES:TODO: Perhaps, if the component is indefinite, we only pick Vanilla? + -- To mimick the old behaviour we need at least profiled too (Vanilla + + -- Prof), and there's even a test for profiled signature, whatever that + -- means. So only doing vanilla way for indefinite components before seems wrong. + -- Consider... + -- ROMES:TODO: Perhaps for executables we want to limit the "wanted" + -- ways to just one? -- ROMES:TODO: From #3294, this may now be possible, after the refactor? -- In the case that there are no C source files that depend on FFI exports, I @@ -125,8 +126,7 @@ build numJobs pkg_descr = do -- We need a separate build and link phase, and C sources must be compiled -- after Haskell modules, because C sources may depend on stub headers -- generated from compiling Haskell modules (#842). - (vanillaOpts, wantedWaysMap) - <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays + (vanillaOpts, wantedWaysMap) <- + buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays extraSources <- buildAllExtraSources ghcProg linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) vanillaOpts wantedWaysMap - diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs index 83d04ff2856..d5c604c0bc8 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs @@ -18,32 +18,33 @@ import Distribution.Types.TargetInfo import Distribution.Simple.GHC.Build.Utils import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program.Types +import Distribution.System (Arch (JavaScript), Platform (..)) +import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentName (componentNameRaw) import Distribution.Types.Executable import Distribution.Verbosity (Verbosity) import System.FilePath -import Distribution.Simple.Program.Types -import Distribution.System (Platform(..), Arch(JavaScript)) -import Distribution.Types.ComponentLocalBuildInfo import Distribution.Simple.Build.Monad -- | An action that builds all the extra build sources of a component, i.e. C, -- C++, Js, Asm, C-- sources. -buildAllExtraSources :: ConfiguredProgram - -- ^ The GHC configured program - -> BuildM [FilePath] - -- ^ Returns the list of extra sources that were built +buildAllExtraSources + :: ConfiguredProgram + -- ^ The GHC configured program + -> BuildM [FilePath] + -- ^ Returns the list of extra sources that were built buildAllExtraSources = fmap concat - . sequence - . sequence - [ buildCSources - , buildCxxSources - , buildJsSources - , buildAsmSources - , buildCmmSources - ] + . sequence + . sequence + [ buildCSources + , buildCxxSources + , buildJsSources + , buildAsmSources + , buildCmmSources + ] buildCSources , buildCxxSources @@ -83,15 +84,14 @@ buildJsSources ghcProg = do "JS Sources" Internal.componentJsGhcOptions False - ( \c -> - if hasJsSupport - then -- JS files are C-like with GHC's JS backend: they are - -- "compiled" into `.o` files (renamed with a header). - -- This is a difference from GHCJS, for which we only - -- pass the JS files at link time. - jsSources (componentBuildInfo c) - else mempty - + ( \c -> + if hasJsSupport + then -- JS files are C-like with GHC's JS backend: they are + -- "compiled" into `.o` files (renamed with a header). + -- This is a difference from GHCJS, for which we only + -- pass the JS files at link time. + jsSources (componentBuildInfo c) + else mempty ) ghcProg buildAsmSources = @@ -147,7 +147,6 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP runGhcProg = runGHC verbosity ghcProg comp platform buildAction sourceFile = do - let baseSrcOpts = componentSourceGhcOptions verbosity @@ -231,11 +230,12 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP | CNotLibName{} <- cname = componentBuildDir lbi clbi componentNameRaw cname <> "-tmp" - in do - -- build any sources - if (null sources || componentIsIndefinite clbi) then do - info verbosity ("Building " ++ description ++ "...") - traverse_ buildAction sources - return sources - else - return [] + in + do + -- build any sources + if (null sources || componentIsIndefinite clbi) + then do + info verbosity ("Building " ++ description ++ "...") + traverse_ buildAction sources + return sources + else return [] diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index 3b0ac5ca988..c945bbdee79 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -1,17 +1,20 @@ {-# LANGUAGE LambdaCase #-} + module Distribution.Simple.GHC.Build.Link where import Distribution.Compat.Prelude import Prelude () import Control.Exception (assert) -import Data.Function ((&)) -import qualified Distribution.InstalledPackageInfo as IPI -import Distribution.Compat.ResponseFile +import Control.Monad (forM_) +import Control.Monad.IO.Class import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Function ((&)) +import qualified Data.Map as Map import Distribution.Compat.Binary (encode) -import Control.Monad (forM_) +import Distribution.Compat.ResponseFile import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo import qualified Distribution.ModuleName as ModuleName import Distribution.Package @@ -21,50 +24,49 @@ import Distribution.Pretty import Distribution.Simple.Build.Monad import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler +import Distribution.Simple.GHC.Build.Modules +import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName) +import Distribution.Simple.GHC.ImplInfo import qualified Distribution.Simple.GHC.Internal as Internal import Distribution.Simple.LocalBuildInfo import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.Program +import qualified Distribution.Simple.Program.Ar as Ar import Distribution.Simple.Program.GHC +import qualified Distribution.Simple.Program.Ld as Ld import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Repl import Distribution.Simple.Utils import Distribution.System +import Distribution.Types.ComponentLocalBuildInfo import Distribution.Utils.NubList import Distribution.Verbosity import Distribution.Version import System.Directory import System.FilePath -import Distribution.Simple.GHC.ImplInfo -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Simple.GHC.Build.Modules -import qualified Distribution.Simple.Program.Ar as Ar -import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName) -import qualified Distribution.Simple.Program.Ld as Ld -import Control.Monad.IO.Class -import qualified Data.Map as Map -- | Links together the object files of the Haskell modules and extra sources -- using the context in which the component is being built. -- -- If the build kind is 'BuildRepl', we load the component into GHCi instead of linking. -linkOrLoadComponent :: ConfiguredProgram - -- ^ The configured GHC program that will be used for linking - -> PackageDescription - -- ^ The package description containing the component being built - -> [FilePath] - -- ^ The full list of extra build sources (all C, C++, Js, - -- Asm, and Cmm sources), which were compiled to object - -- files. - -> (FilePath, FilePath) - -- ^ The build target dir, and the target dir. - -- See Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build - -> GhcOptions - -- ^ The vanilla base options used across build invocations - -- of GHC, which may be used for loading the component in the repl. - -> Map.Map BuildWay GhcOptions - -- ^ The set of build ways wanted based on the user opts - -> BuildM () +linkOrLoadComponent + :: ConfiguredProgram + -- ^ The configured GHC program that will be used for linking + -> PackageDescription + -- ^ The package description containing the component being built + -> [FilePath] + -- ^ The full list of extra build sources (all C, C++, Js, + -- Asm, and Cmm sources), which were compiled to object + -- files. + -> (FilePath, FilePath) + -- ^ The build target dir, and the target dir. + -- See Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build + -> GhcOptions + -- ^ The vanilla base options used across build invocations + -- of GHC, which may be used for loading the component in the repl. + -> Map.Map BuildWay GhcOptions + -- ^ The set of build ways wanted based on the user opts + -> BuildM () linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) vanillaOpts wantedWaysMap = do verbosity <- buildVerbosity target <- buildTarget @@ -139,22 +141,22 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) v -- exports. when (case component of CLib lib -> null (allLibModules lib clbi); _ -> False) $ warn verbosity "No exposed modules" runReplOrWriteFlags ghcProg lbi replFlags replOpts (pkgName (PD.package pkg_descr)) target - _otherwise -> let runGhcProg = runGHC verbosity ghcProg comp platform platform = hostPlatform lbi comp = compiler lbi - in when (not $ componentIsIndefinite clbi) $ do - rpaths <- if DynWay `elem` Map.keys wantedWaysMap then getRPaths else return (toNubListR []) - liftIO $ do - info verbosity "Linking..." - case component of - CLib lib -> linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWaysMap - CFLib flib -> linkFLib flib bi lbi (linkerOpts, rpaths) wantedWaysMap targetDir runGhcProg - CExe exe -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (exeName exe) runGhcProg lbi - CTest test -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (testName test) runGhcProg lbi - CBench bench -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (benchmarkName bench) runGhcProg lbi + in + when (not $ componentIsIndefinite clbi) $ do + rpaths <- if DynWay `elem` Map.keys wantedWaysMap then getRPaths else return (toNubListR []) + liftIO $ do + info verbosity "Linking..." + case component of + CLib lib -> linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWaysMap + CFLib flib -> linkFLib flib bi lbi (linkerOpts, rpaths) wantedWaysMap targetDir runGhcProg + CExe exe -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (exeName exe) runGhcProg lbi + CTest test -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (testName test) runGhcProg lbi + CBench bench -> linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir (benchmarkName bench) runGhcProg lbi -- ROMES:TODO: This module can still be very much refactored. I'm pretty sure we -- can merge all implementations of link for each component into one simpler @@ -162,25 +164,26 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) v -- to the linker invocation. GHC can probably find the right object files to -- link based on the suffix prefix. -linkLibrary :: FilePath - -- ^ The library target build directory - -> [FilePath] - -- ^ The list of extra lib dirs that exist (aka cleaned) - -> PackageDescription - -- ^ The package description containing this library - -> Verbosity - -> (GhcOptions -> IO ()) - -- ^ Run the configured Ghc program - -> Library - -> LocalBuildInfo - -> ComponentLocalBuildInfo - -> [FilePath] - -- ^ Extra build sources (that were compiled to objects) - -> NubListR FilePath - -- ^ A list with the runtime-paths (rpaths), or empty if not linking dynamically - -> Map.Map BuildWay GhcOptions - -- ^ Wanted build ways and corresponding build options - -> IO () +linkLibrary + :: FilePath + -- ^ The library target build directory + -> [FilePath] + -- ^ The list of extra lib dirs that exist (aka cleaned) + -> PackageDescription + -- ^ The package description containing this library + -> Verbosity + -> (GhcOptions -> IO ()) + -- ^ Run the configured Ghc program + -> Library + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> [FilePath] + -- ^ Extra build sources (that were compiled to objects) + -> NubListR FilePath + -- ^ A list with the runtime-paths (rpaths), or empty if not linking dynamically + -> Map.Map BuildWay GhcOptions + -- ^ Wanted build ways and corresponding build options + -> IO () linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWaysMap = do let compiler_id = compilerId comp @@ -211,27 +214,30 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li libInstallPath mkSharedLibName (hostPlatform lbi) compiler_id uid - getObjFiles way = concat <$> sequenceA - [ Internal.getHaskellObjects - implInfo - lib - lbi - clbi - buildTargetDir - (buildWayPrefix way ++ objExtension) - True - , pure $ - map (buildTargetDir ) $ - map ((`replaceExtension` (buildWayPrefix way ++ objExtension))) extraSources - , catMaybes <$> sequenceA - [ findFileWithExtension - [buildWayPrefix way ++ objExtension] - [buildTargetDir] - (ModuleName.toFilePath x ++ "_stub") - | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files - , x <- allLibModules lib clbi + getObjFiles way = + concat + <$> sequenceA + [ Internal.getHaskellObjects + implInfo + lib + lbi + clbi + buildTargetDir + (buildWayPrefix way ++ objExtension) + True + , pure $ + map (buildTargetDir ) $ + map ((`replaceExtension` (buildWayPrefix way ++ objExtension))) extraSources + , catMaybes + <$> sequenceA + [ findFileWithExtension + [buildWayPrefix way ++ objExtension] + [buildTargetDir] + (ModuleName.toFilePath x ++ "_stub") + | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files + , x <- allLibModules lib clbi + ] ] - ] -- ROMES:TODO: I'm fairly certain that, just like the executable, we can keep just the -- module input list, and point to the right output dir (as is already @@ -274,7 +280,7 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li , ghcOptLinkLibs = extraLibs libBi , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs -- ROMES:TODO: why not extra dirs static??? } - -- ROMES:TODO: Try to figure out if we could do the same "commonOpt `mappend` linkerOpts" as we do for repl here + -- ROMES:TODO: Try to figure out if we could do the same "commonOpt `mappend` linkerOpts" as we do for repl here staticObjectFiles <- getObjFiles StaticWay profObjectFiles <- getObjFiles ProfWay @@ -310,11 +316,9 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li -- ROMES: Why exactly branch on staticObjectFiles, rather than any other build -- kind that we might have wanted instead? unless (null staticObjectFiles) $ do - info verbosity (show (ghcOptPackages (Internal.componentGhcOptions verbosity lbi libBi clbi buildTargetDir))) traverse_ linkWay (Map.toList wantedWaysMap) - -- ROMES:TODO: Have to be careful about target dir vs build dir here! They are -- not the same on exes, and we don't want to conflate them for now, even @@ -322,21 +326,22 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li -- | Link the executable resulting from building this component, be it an -- executable, test, or benchmark component. -linkExecutable :: (GhcOptions, NubListR FilePath) - -- ^ The linker-specific GHC options, and the RPaths to include - -- in dynamically linked binaries - -> Map.Map BuildWay GhcOptions - -- ^ The wanted build ways and corresponding GhcOptions that were - -- used to compile the modules in that way. - -> FilePath - -- ^ The target dir (2024-01:note: not the same as build target - -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build) - -> UnqualComponentName - -- ^ Name of executable-like target - -> (GhcOptions -> IO ()) - -- ^ Run the configured GHC program - -> LocalBuildInfo - -> IO () +linkExecutable + :: (GhcOptions, NubListR FilePath) + -- ^ The linker-specific GHC options, and the RPaths to include + -- in dynamically linked binaries + -> Map.Map BuildWay GhcOptions + -- ^ The wanted build ways and corresponding GhcOptions that were + -- used to compile the modules in that way. + -> FilePath + -- ^ The target dir (2024-01:note: not the same as build target + -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build) + -> UnqualComponentName + -- ^ Name of executable-like target + -> (GhcOptions -> IO ()) + -- ^ Run the configured GHC program + -> LocalBuildInfo + -> IO () linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir targetName runGhcProg lbi = -- When building an executable, we should only "want" one build way. assert (Map.size wantedWaysMap == 1) $ @@ -358,21 +363,23 @@ linkExecutable (linkerOpts, rpaths) wantedWaysMap targetDir targetName runGhcPro when e (removeFile target) runGhcProg linkOpts{ghcOptOutputFile = toFlag target} - -- | Link a foreign library component -linkFLib :: ForeignLib -> BuildInfo -> LocalBuildInfo - -> (GhcOptions, NubListR FilePath) - -- ^ The linker-specific GHC options, and the RPaths to include - -- in dynamically linked binaries - -> Map.Map BuildWay GhcOptions - -- ^ The wanted build ways and corresponding GhcOptions that were - -- used to compile the modules in that way. - -> FilePath - -- ^ The target dir (2024-01:note: not the same as build target - -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build) - -> (GhcOptions -> IO ()) - -- ^ Run the configured GHC program - -> IO () +linkFLib + :: ForeignLib + -> BuildInfo + -> LocalBuildInfo + -> (GhcOptions, NubListR FilePath) + -- ^ The linker-specific GHC options, and the RPaths to include + -- in dynamically linked binaries + -> Map.Map BuildWay GhcOptions + -- ^ The wanted build ways and corresponding GhcOptions that were + -- used to compile the modules in that way. + -> FilePath + -- ^ The target dir (2024-01:note: not the same as build target + -- dir, see Note [Build Target Dir vs Target Dir] in Distribution.Simple.GHC.Build) + -> (GhcOptions -> IO ()) + -- ^ Run the configured GHC program + -> IO () linkFLib flib bi lbi (linkerOpts, rpaths) wantedWaysMap targetDir runGhcProg = do let comp = compiler lbi @@ -405,10 +412,11 @@ linkFLib flib bi lbi (linkerOpts, rpaths) wantedWaysMap targetDir runGhcProg = d else statRtsVanillaLib (rtsStaticInfo rtsInfo) ] - linkOpts :: (BuildWay, GhcOptions) - -- ^ Opts for the way in which we want to build the FLib - -> GhcOptions - linkOpts (way,opts) = case foreignLibType flib of + linkOpts + :: (BuildWay, GhcOptions) + -- \^ Opts for the way in which we want to build the FLib + -> GhcOptions + linkOpts (way, opts) = case foreignLibType flib of ForeignLibNativeShared -> opts `mappend` linkerOpts @@ -419,7 +427,7 @@ linkFLib flib bi lbi (linkerOpts, rpaths) wantedWaysMap targetDir runGhcProg = d , ghcOptFPic = toFlag True , ghcOptLinkModDefFiles = toNubListR $ foreignLibModDefFile flib } - & (if withDynExe lbi then \x -> x{ghcOptRPaths = rpaths} else id) + & (if withDynExe lbi then \x -> x{ghcOptRPaths = rpaths} else id) ForeignLibNativeStatic -> -- this should be caught by buildFLib -- (and if we do implement this, we probably don't even want to call @@ -489,8 +497,7 @@ getRPaths = do relPath p = if isRelative p then hostPref p else p rpaths = toNubListR (map relPath libraryPaths) return rpaths - else - return mempty + else return mempty data DynamicRtsInfo = DynamicRtsInfo { dynRtsVanillaLib :: FilePath @@ -567,7 +574,6 @@ hasThreaded bi = elem "-threaded" ghc where PerCompilerFlavor ghc _ = options bi - -- | Load a target component into a repl, or write to disk a script which runs -- GHCi with the GHC options Cabal elaborated to load the component interactively. runReplOrWriteFlags @@ -583,38 +589,36 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target = clbi = targetCLBI target comp = compiler lbi platform = hostPlatform lbi - in - case replOptionsFlagOutput (replReplOptions rflags) of - NoFlag -> runGHC (fromFlag $ replVerbosity rflags) ghcProg comp platform ghcOpts - Flag out_dir -> do - src_dir <- getCurrentDirectory - let uid = componentUnitId clbi - this_unit = prettyShow uid - reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi] - hidden_modules = otherModules bi - extra_opts = - concat $ - [ ["-this-package-name", prettyShow pkg_name] - , ["-working-dir", src_dir] - ] - ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules - ] - ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules - ] - -- Create "paths" subdirectory if it doesn't exist. This is where we write - -- information about how the PATH was augmented. - createDirectoryIfMissing False (out_dir "paths") - -- Write out the PATH information into `paths` subdirectory. - writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) - -- Write out options for this component into a file ready for loading into - -- the multi-repl - writeFileAtomic (out_dir this_unit) $ - BS.pack $ - escapeArgs $ - extra_opts ++ renderGhcOptions comp platform (ghcOpts{ghcOptMode = NoFlag}) + in case replOptionsFlagOutput (replReplOptions rflags) of + NoFlag -> runGHC (fromFlag $ replVerbosity rflags) ghcProg comp platform ghcOpts + Flag out_dir -> do + src_dir <- getCurrentDirectory + let uid = componentUnitId clbi + this_unit = prettyShow uid + reexported_modules = [mn | LibComponentLocalBuildInfo{} <- [clbi], IPI.ExposedModule mn (Just{}) <- componentExposedModules clbi] + hidden_modules = otherModules bi + extra_opts = + concat $ + [ ["-this-package-name", prettyShow pkg_name] + , ["-working-dir", src_dir] + ] + ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules + ] + ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules + ] + -- Create "paths" subdirectory if it doesn't exist. This is where we write + -- information about how the PATH was augmented. + createDirectoryIfMissing False (out_dir "paths") + -- Write out the PATH information into `paths` subdirectory. + writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) + -- Write out options for this component into a file ready for loading into + -- the multi-repl + writeFileAtomic (out_dir this_unit) $ + BS.pack $ + escapeArgs $ + extra_opts ++ renderGhcOptions comp platform (ghcOpts{ghcOptMode = NoFlag}) replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a replNoLoad replFlags l | replOptionsNoLoad replFlags == Flag True = mempty | otherwise = l - diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs index 7e24aa7f9d2..70ef58b9a2c 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs @@ -1,43 +1,43 @@ -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} -module Distribution.Simple.GHC.Build.Modules - ( buildHaskellModules, BuildWay(..), buildWayPrefix ) - where +{-# LANGUAGE TupleSections #-} + +module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..), buildWayPrefix) +where -import Distribution.Compat.Prelude import Control.Monad.IO.Class +import Distribution.Compat.Prelude import Data.Function ((&)) -import Distribution.Types.ParStrat -import Distribution.Simple.Compiler -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Utils -import Distribution.Utils.NubList -import System.FilePath +import Data.List (sortOn, (\\)) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Distribution.CabalSpecVersion +import Distribution.ModuleName (ModuleName) +import qualified Distribution.PackageDescription as PD +import Distribution.Pretty import Distribution.Simple.Build.Monad +import Distribution.Simple.Compiler import Distribution.Simple.GHC.Build.Utils +import qualified Distribution.Simple.GHC.Internal as Internal import qualified Distribution.Simple.Hpc as Hpc -import Distribution.Simple.Setup.Common -import Distribution.Simple.Program.Types +import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.GHC -import Distribution.Types.ForeignLib -import Distribution.Types.Executable -import Distribution.Types.TestSuite +import Distribution.Simple.Program.Types +import Distribution.Simple.Setup.Common +import Distribution.Simple.Utils import Distribution.Types.Benchmark -import Distribution.Types.BuildInfo -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.List ((\\), sortOn) -import qualified Distribution.Simple.GHC.Internal as Internal -import Distribution.ModuleName (ModuleName) -import Distribution.Types.TestSuiteInterface import Distribution.Types.BenchmarkInterface -import Distribution.Pretty -import Distribution.CabalSpecVersion +import Distribution.Types.BuildInfo +import Distribution.Types.Executable +import Distribution.Types.ForeignLib import Distribution.Types.PackageName.Magic -import qualified Distribution.PackageDescription as PD +import Distribution.Types.ParStrat +import Distribution.Types.TestSuite +import Distribution.Types.TestSuiteInterface +import Distribution.Utils.NubList +import System.FilePath {- Note [Building Haskell Modules accounting for TH] @@ -92,39 +92,41 @@ To build an executable statically, with a static by default GHC, regardless of w -} -- | Compile the Haskell modules of the component being built. -buildHaskellModules :: Flag ParStrat - -- ^ The parallelism strategy (e.g. num of jobs) - -> ConfiguredProgram - -- ^ The GHC configured program - -> PD.PackageDescription - -- ^ The package description - -> FilePath - -- ^ The path to the build directory for this target, which - -- has already been created. - -> Set.Set BuildWay - -- ^ The set of wanted build ways according to user options - -> BuildM (GhcOptions, Map.Map BuildWay GhcOptions) - -- ^ Returns a mapping from the wanted build ways to the - -- GhcOptions used in the invocation to compile in each - -- wanted way, plus the base 'GhcOptions' used in each - -- invocation of GHC across build ways. The base options - -- may then be used for loading the component in the repl - -- as well. --- See Note [Building Haskell Modules accounting for TH] +buildHaskellModules + :: Flag ParStrat + -- ^ The parallelism strategy (e.g. num of jobs) + -> ConfiguredProgram + -- ^ The GHC configured program + -> PD.PackageDescription + -- ^ The package description + -> FilePath + -- ^ The path to the build directory for this target, which + -- has already been created. + -> Set.Set BuildWay + -- ^ The set of wanted build ways according to user options + -> BuildM (GhcOptions, Map.Map BuildWay GhcOptions) + -- ^ Returns a mapping from the wanted build ways to the + -- GhcOptions used in the invocation to compile in each + -- wanted way, plus the base 'GhcOptions' used in each + -- invocation of GHC across build ways. The base options + -- may then be used for loading the component in the repl + -- as well. + -- See Note [Building Haskell Modules accounting for TH] buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do verbosity <- buildVerbosity component <- buildComponent - clbi <- buildCLBI - lbi <- buildLBI - bi <- buildBI - what <- buildWhat - comp <- buildCompiler - - let isLib | CLib{} <- component = True - | otherwise = False + clbi <- buildCLBI + lbi <- buildLBI + bi <- buildBI + what <- buildWhat + comp <- buildCompiler + + let isLib + | CLib{} <- component = True + | otherwise = False forRepl - | BuildRepl{} <- what = True - | otherwise = False + | BuildRepl{} <- what = True + | otherwise = False -- TODO: do we need to put hs-boot files into place for mutually recursive -- modules? FIX: what about exeName.hi-boot? @@ -149,7 +151,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do -- We define the base opts which are shared across different build ways in -- 'buildHaskellModules', and also serves as the base options for loading -- modules in 'linkOrLoadComponent' (hence we return them). - baseOpts way = + baseOpts way = (Internal.componentGhcOptions verbosity lbi bi clbi buildTargetDir) `mappend` mempty { ghcOptMode = toFlag GhcModeMake @@ -162,26 +164,26 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do if PD.package pkg_descr == fakePackageId then filter isHaskell inputFiles else inputFiles - -- ROMES:TODO: We're doing something wrong here, because - -- componentInputs doesn't return non-haskell inputFiles. - -- Re-think. - , ghcOptInputScripts = + , -- ROMES:TODO: We're doing something wrong here, because + -- componentInputs doesn't return non-haskell inputFiles. + -- Re-think. + ghcOptInputScripts = toNubListR $ if PD.package pkg_descr == fakePackageId then filter (not . isHaskell) inputFiles else [] - , ghcOptExtra = fromMaybe mempty (buildWayExtraHcOptions way) GHC bi } - -- We only want to add these options in if not building Vanilla. - -- Otherwise, we can omit them. - & if way == VanillaWay - then id - else - \x -> x{ ghcOptHiSuffix = toFlag (buildWayPrefix way ++ "hi") - , ghcOptObjSuffix = toFlag (buildWayPrefix way ++ "o") - , ghcOptHPCDir = hpcdir (buildWayHpcWay way) - } + -- We only want to add these options in if not building Vanilla. + -- Otherwise, we can omit them. + & if way == VanillaWay + then id + else \x -> + x + { ghcOptHiSuffix = toFlag (buildWayPrefix way ++ "hi") + , ghcOptObjSuffix = toFlag (buildWayPrefix way ++ "o") + , ghcOptHPCDir = hpcdir (buildWayHpcWay way) + } vanillaOpts = baseOpts VanillaWay @@ -189,79 +191,77 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do dynOpts = (baseOpts DynWay) { ghcOptDynLinkMode = toFlag GhcDynamicOnly - -- TODO: Does it hurt to set -fPIC for executables? - , ghcOptFPic = toFlag True + , -- TODO: Does it hurt to set -fPIC for executables? + ghcOptFPic = toFlag True } profOpts = (baseOpts ProfWay) - { ghcOptProfilingMode = toFlag True - , ghcOptProfilingAuto = - Internal.profDetailLevelFlag - (if isLib then True else False) - ((if isLib then withProfLibDetail else withProfExeDetail) lbi) - } + { ghcOptProfilingMode = toFlag True + , ghcOptProfilingAuto = + Internal.profDetailLevelFlag + (if isLib then True else False) + ((if isLib then withProfLibDetail else withProfExeDetail) lbi) + } dynTooOpts = (baseOpts DynWay){ghcOptDynLinkMode = toFlag GhcStaticAndDynamic} defaultGhcWay = if isDynamic comp then DynWay else StaticWay -- If there aren't modules, or if we're loading the modules in repl, don't build. - if (forRepl || (null inputFiles && null inputModules)) then liftIO $ - - -- See Note [Building Haskell Modules accounting for TH] - let - - neededWays - = wantedWays - <> Set.fromList - -- TODO: You also don't need this if you are using an external interpreter!! - [defaultGhcWay | doingTH && defaultGhcWay `Set.notMember` wantedWays] - - -- If we need both static and dynamic, use dynamic-too instead of - -- compiling twice (if we support it) - useDynamicToo - -- TODO: These vanilla way are kind of bothersome. Ask Matthew. - = (StaticWay `Set.member` neededWays || VanillaWay `Set.member` neededWays) - && DynWay `Set.member` neededWays - && supportsDynamicToo comp - && null (hcSharedOptions GHC bi) - - -- The ways we'll build, in order - orderedBuilds - - -- If we can use dynamic-too, do it first. The default GHC way can only - -- be static or dynamic, so, if we build both right away, any modules - -- possibly needed by TH later (e.g. if building profiled) are already built. - | useDynamicToo - = [ buildStaticAndDynamicToo ] ++ - (buildWay <$> Set.toList neededWays \\ [StaticWay, VanillaWay, DynWay]) - - -- Otherwise, we need to ensure the defaultGhcWay is built first. - | otherwise - = buildWay <$> sortOn (\w -> if w == defaultGhcWay then 0 else 1 :: Int) (Set.toList neededWays) - - buildWay way = uncurry Map.singleton . (way,) <$> case way of - StaticWay -> runGhcProg staticOpts >> return staticOpts - DynWay -> runGhcProg dynOpts >> return dynOpts - ProfWay -> runGhcProg profOpts >> return profOpts - VanillaWay -> runGhcProg vanillaOpts >> return vanillaOpts - - buildStaticAndDynamicToo = do - runGhcProg dynTooOpts - case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of - (Flag dynDir, Flag vanillaDir) -> - -- When the vanilla and shared library builds are done - -- in one pass, only one set of HPC module interfaces - -- are generated. This set should suffice for both - -- static and dynamically linked executables. We copy - -- the modules interfaces so they are available under - -- both ways. - copyDirectoryRecursive verbosity dynDir vanillaDir - _ -> return () - return (Map.fromList [(StaticWay, staticOpts), (DynWay, dynOpts)]) - - in (baseOpts VanillaWay,) . Map.unions <$> sequence orderedBuilds - else - return mempty + if (forRepl || (null inputFiles && null inputModules)) + then + liftIO $ + -- See Note [Building Haskell Modules accounting for TH] + let + neededWays = + wantedWays + <> Set.fromList + -- TODO: You also don't need this if you are using an external interpreter!! + [defaultGhcWay | doingTH && defaultGhcWay `Set.notMember` wantedWays] + + -- If we need both static and dynamic, use dynamic-too instead of + -- compiling twice (if we support it) + useDynamicToo = + -- TODO: These vanilla way are kind of bothersome. Ask Matthew. + (StaticWay `Set.member` neededWays || VanillaWay `Set.member` neededWays) + && DynWay `Set.member` neededWays + && supportsDynamicToo comp + && null (hcSharedOptions GHC bi) + + -- The ways we'll build, in order + orderedBuilds + -- If we can use dynamic-too, do it first. The default GHC way can only + -- be static or dynamic, so, if we build both right away, any modules + -- possibly needed by TH later (e.g. if building profiled) are already built. + | useDynamicToo = + [buildStaticAndDynamicToo] + ++ (buildWay <$> Set.toList neededWays \\ [StaticWay, VanillaWay, DynWay]) + -- Otherwise, we need to ensure the defaultGhcWay is built first. + | otherwise = + buildWay <$> sortOn (\w -> if w == defaultGhcWay then 0 else 1 :: Int) (Set.toList neededWays) + + buildWay way = + uncurry Map.singleton . (way,) <$> case way of + StaticWay -> runGhcProg staticOpts >> return staticOpts + DynWay -> runGhcProg dynOpts >> return dynOpts + ProfWay -> runGhcProg profOpts >> return profOpts + VanillaWay -> runGhcProg vanillaOpts >> return vanillaOpts + + buildStaticAndDynamicToo = do + runGhcProg dynTooOpts + case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of + (Flag dynDir, Flag vanillaDir) -> + -- When the vanilla and shared library builds are done + -- in one pass, only one set of HPC module interfaces + -- are generated. This set should suffice for both + -- static and dynamically linked executables. We copy + -- the modules interfaces so they are available under + -- both ways. + copyDirectoryRecursive verbosity dynDir vanillaDir + _ -> return () + return (Map.fromList [(StaticWay, staticOpts), (DynWay, dynOpts)]) + in + (baseOpts VanillaWay,) . Map.unions <$> sequence orderedBuilds + else return mempty data BuildWay = StaticWay | DynWay | ProfWay | VanillaWay deriving (Eq, Ord) @@ -287,36 +287,36 @@ buildWayHpcWay = \case buildWayExtraHcOptions :: BuildWay -> Maybe (CompilerFlavor -> BuildInfo -> [String]) buildWayExtraHcOptions = \case VanillaWay -> Nothing - StaticWay -> Just hcStaticOptions + StaticWay -> Just hcStaticOptions ProfWay -> Just hcProfOptions DynWay -> Just hcSharedOptions -- | Returns a pair of the Haskell input files and Haskell modules of the -- component being built. -componentInputs :: FilePath - -- ^ Target build dir - -> PD.PackageDescription - -> BuildM ([FilePath], [ModuleName]) - -- ^ The Haskell input files, and the Haskell modules +componentInputs + :: FilePath + -- ^ Target build dir + -> PD.PackageDescription + -> BuildM ([FilePath], [ModuleName]) + -- ^ The Haskell input files, and the Haskell modules componentInputs buildTargetDir pkg_descr = do verbosity <- buildVerbosity component <- buildComponent clbi <- buildCLBI case component of - CLib lib - -> pure ([], allLibModules lib clbi) - CFLib flib - -> pure ([], foreignLibModules flib) - CExe Executable{buildInfo=bi', modulePath} - -> exeLikeInputs verbosity bi' modulePath - CTest TestSuite{testBuildInfo=bi', testInterface = TestSuiteExeV10 _ mainFile } - -> exeLikeInputs verbosity bi' mainFile - CBench Benchmark{benchmarkBuildInfo=bi', benchmarkInterface = BenchmarkExeV10 _ mainFile } - -> exeLikeInputs verbosity bi' mainFile + CLib lib -> + pure ([], allLibModules lib clbi) + CFLib flib -> + pure ([], foreignLibModules flib) + CExe Executable{buildInfo = bi', modulePath} -> + exeLikeInputs verbosity bi' modulePath + CTest TestSuite{testBuildInfo = bi', testInterface = TestSuiteExeV10 _ mainFile} -> + exeLikeInputs verbosity bi' mainFile + CBench Benchmark{benchmarkBuildInfo = bi', benchmarkInterface = BenchmarkExeV10 _ mainFile} -> + exeLikeInputs verbosity bi' mainFile CTest TestSuite{} -> error "testSuiteExeV10AsExe: wrong kind" CBench Benchmark{} -> error "benchmarkExeV10asExe: wrong kind" - where exeLikeInputs verbosity bnfo modulePath = liftIO $ do main <- findExecutableMain verbosity buildTargetDir (bnfo, modulePath) @@ -324,25 +324,25 @@ componentInputs buildTargetDir pkg_descr = do otherModNames = otherModules bnfo -- Scripts have fakePackageId and are always Haskell but can have any extension. - if isHaskell main || PD.package pkg_descr == fakePackageId then - if PD.specVersion pkg_descr < CabalSpecV2_0 && (mainModName `elem` otherModNames) then do - -- The cabal manual clearly states that `other-modules` is - -- intended for non-main modules. However, there's at least one - -- important package on Hackage (happy-1.19.5) which - -- violates this. We workaround this here so that we don't - -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which - -- would result in GHC complaining about duplicate Main - -- modules. - -- - -- Finally, we only enable this workaround for - -- specVersion < 2, as 'cabal-version:>=2.0' cabal files - -- have no excuse anymore to keep doing it wrong... ;-) - warn verbosity $ - "Enabling workaround for Main module '" - ++ prettyShow mainModName - ++ "' listed in 'other-modules' illegally!" - return ([main], filter (/= mainModName) otherModNames) - else - return ([main], otherModNames) - else - return ([], otherModNames) + if isHaskell main || PD.package pkg_descr == fakePackageId + then + if PD.specVersion pkg_descr < CabalSpecV2_0 && (mainModName `elem` otherModNames) + then do + -- The cabal manual clearly states that `other-modules` is + -- intended for non-main modules. However, there's at least one + -- important package on Hackage (happy-1.19.5) which + -- violates this. We workaround this here so that we don't + -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which + -- would result in GHC complaining about duplicate Main + -- modules. + -- + -- Finally, we only enable this workaround for + -- specVersion < 2, as 'cabal-version:>=2.0' cabal files + -- have no excuse anymore to keep doing it wrong... ;-) + warn verbosity $ + "Enabling workaround for Main module '" + ++ prettyShow mainModName + ++ "' listed in 'other-modules' illegally!" + return ([main], filter (/= mainModName) otherModNames) + else return ([main], otherModNames) + else return ([], otherModNames) diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 4c7290aae48..3ab3c85be35 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -514,81 +514,80 @@ componentGhcOptions -> GhcOptions componentGhcOptions verbosity lbi bi clbi odir = let implInfo = getImplInfo $ compiler lbi - in - mempty - { -- Respect -v0, but don't crank up verbosity on GHC if - -- Cabal verbosity is requested. For that, use --ghc-option=-v instead! - ghcOptVerbosity = toFlag (min verbosity normal) - , ghcOptCabal = toFlag True - , ghcOptThisUnitId = case clbi of - LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> - toFlag pk - _ | not (unitIdForExes implInfo) -> mempty - ExeComponentLocalBuildInfo{componentUnitId = uid} -> - toFlag (unUnitId uid) - TestComponentLocalBuildInfo{componentUnitId = uid} -> - toFlag (unUnitId uid) - BenchComponentLocalBuildInfo{componentUnitId = uid} -> - toFlag (unUnitId uid) - FLibComponentLocalBuildInfo{componentUnitId = uid} -> - toFlag (unUnitId uid) - , ghcOptThisComponentId = case clbi of - LibComponentLocalBuildInfo - { componentComponentId = cid - , componentInstantiatedWith = insts - } -> - if null insts - then mempty - else toFlag cid - _ -> mempty - , ghcOptInstantiatedWith = case clbi of - LibComponentLocalBuildInfo{componentInstantiatedWith = insts} -> - insts - _ -> [] - , ghcOptNoCode = toFlag $ componentIsIndefinite clbi - , ghcOptHideAllPackages = toFlag True - , ghcOptWarnMissingHomeModules = toFlag $ flagWarnMissingHomeModules implInfo - , ghcOptPackageDBs = withPackageDB lbi - , ghcOptPackages = toNubListR $ mkGhcOptPackages mempty clbi - , ghcOptSplitSections = toFlag (splitSections lbi) - , ghcOptSplitObjs = toFlag (splitObjs lbi) - , ghcOptSourcePathClear = toFlag True - , ghcOptSourcePath = - toNubListR $ - map getSymbolicPath (hsSourceDirs bi) - ++ [odir] - ++ [autogenComponentModulesDir lbi clbi] - ++ [autogenPackageModulesDir lbi] - , ghcOptCppIncludePath = - toNubListR $ - [ autogenComponentModulesDir lbi clbi - , autogenPackageModulesDir lbi - , odir - ] - -- includes relative to the package - ++ includeDirs bi - -- potential includes generated by `configure' - -- in the build directory - ++ [buildDir lbi dir | dir <- includeDirs bi] - , ghcOptCppOptions = cppOptions bi - , ghcOptCppIncludes = - toNubListR $ - [autogenComponentModulesDir lbi clbi cppHeaderName] - , ghcOptFfiIncludes = toNubListR $ includes bi - , ghcOptObjDir = toFlag odir - , ghcOptHiDir = toFlag odir - , ghcOptHieDir = bool NoFlag (toFlag $ odir extraCompilationArtifacts "hie") $ flagHie implInfo - , ghcOptStubDir = toFlag odir - , ghcOptOutputDir = toFlag odir - , ghcOptOptimisation = toGhcOptimisation (withOptimization lbi) - , ghcOptDebugInfo = toFlag (withDebugInfo lbi) - , ghcOptExtra = hcOptions GHC bi - , ghcOptExtraPath = toNubListR $ exe_paths - , ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)) - , -- Unsupported extensions have already been checked by configure - ghcOptExtensions = toNubListR $ usedExtensions bi - , ghcOptExtensionMap = Map.fromList . compilerExtensions $ (compiler lbi) - } + in mempty + { -- Respect -v0, but don't crank up verbosity on GHC if + -- Cabal verbosity is requested. For that, use --ghc-option=-v instead! + ghcOptVerbosity = toFlag (min verbosity normal) + , ghcOptCabal = toFlag True + , ghcOptThisUnitId = case clbi of + LibComponentLocalBuildInfo{componentCompatPackageKey = pk} -> + toFlag pk + _ | not (unitIdForExes implInfo) -> mempty + ExeComponentLocalBuildInfo{componentUnitId = uid} -> + toFlag (unUnitId uid) + TestComponentLocalBuildInfo{componentUnitId = uid} -> + toFlag (unUnitId uid) + BenchComponentLocalBuildInfo{componentUnitId = uid} -> + toFlag (unUnitId uid) + FLibComponentLocalBuildInfo{componentUnitId = uid} -> + toFlag (unUnitId uid) + , ghcOptThisComponentId = case clbi of + LibComponentLocalBuildInfo + { componentComponentId = cid + , componentInstantiatedWith = insts + } -> + if null insts + then mempty + else toFlag cid + _ -> mempty + , ghcOptInstantiatedWith = case clbi of + LibComponentLocalBuildInfo{componentInstantiatedWith = insts} -> + insts + _ -> [] + , ghcOptNoCode = toFlag $ componentIsIndefinite clbi + , ghcOptHideAllPackages = toFlag True + , ghcOptWarnMissingHomeModules = toFlag $ flagWarnMissingHomeModules implInfo + , ghcOptPackageDBs = withPackageDB lbi + , ghcOptPackages = toNubListR $ mkGhcOptPackages mempty clbi + , ghcOptSplitSections = toFlag (splitSections lbi) + , ghcOptSplitObjs = toFlag (splitObjs lbi) + , ghcOptSourcePathClear = toFlag True + , ghcOptSourcePath = + toNubListR $ + map getSymbolicPath (hsSourceDirs bi) + ++ [odir] + ++ [autogenComponentModulesDir lbi clbi] + ++ [autogenPackageModulesDir lbi] + , ghcOptCppIncludePath = + toNubListR $ + [ autogenComponentModulesDir lbi clbi + , autogenPackageModulesDir lbi + , odir + ] + -- includes relative to the package + ++ includeDirs bi + -- potential includes generated by `configure' + -- in the build directory + ++ [buildDir lbi dir | dir <- includeDirs bi] + , ghcOptCppOptions = cppOptions bi + , ghcOptCppIncludes = + toNubListR $ + [autogenComponentModulesDir lbi clbi cppHeaderName] + , ghcOptFfiIncludes = toNubListR $ includes bi + , ghcOptObjDir = toFlag odir + , ghcOptHiDir = toFlag odir + , ghcOptHieDir = bool NoFlag (toFlag $ odir extraCompilationArtifacts "hie") $ flagHie implInfo + , ghcOptStubDir = toFlag odir + , ghcOptOutputDir = toFlag odir + , ghcOptOptimisation = toGhcOptimisation (withOptimization lbi) + , ghcOptDebugInfo = toFlag (withDebugInfo lbi) + , ghcOptExtra = hcOptions GHC bi + , ghcOptExtraPath = toNubListR $ exe_paths + , ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)) + , -- Unsupported extensions have already been checked by configure + ghcOptExtensions = toNubListR $ usedExtensions bi + , ghcOptExtensionMap = Map.fromList . compilerExtensions $ (compiler lbi) + } where exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt)