diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index e6187ce9a1885ac4c8765432b151e4df71094cd0..cbd52b5a6e8902f473d4760c6f528d819e9a92e7 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -88,6 +88,7 @@ library
Distribution.Simple
Distribution.Simple.Bench
Distribution.Simple.Build
+ Distribution.Simple.Build.Inputs
Distribution.Simple.Build.Macros
Distribution.Simple.Build.PackageInfoModule
Distribution.Simple.Build.PathsModule
@@ -332,8 +333,10 @@ library
Distribution.Simple.Build.PackageInfoModule.Z
Distribution.Simple.Build.PathsModule.Z
Distribution.Simple.GHC.Build
- Distribution.Simple.GHC.BuildOrRepl
- Distribution.Simple.GHC.BuildGeneric
+ Distribution.Simple.GHC.Build.ExtraSources
+ Distribution.Simple.GHC.Build.Link
+ Distribution.Simple.GHC.Build.Modules
+ Distribution.Simple.GHC.Build.Utils
Distribution.Simple.GHC.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.ImplInfo
diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index 429afced1bae685d35297bdbffc6789750fadcc1..afe571d71960675b0d2f17928989cffca213ec2a 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -161,7 +161,7 @@ build pkg_descr lbi flags suffixes = do
NoFlag -> Serial
mb_ipi <-
buildComponent
- verbosity
+ flags
par_strat
pkg_descr
lbi'
@@ -301,7 +301,7 @@ repl pkg_descr lbi flags suffixes args = do
lbi' = lbiForComponent comp lbi
preBuildComponent verbosity lbi subtarget
buildComponent
- verbosity
+ mempty{buildVerbosity = toFlag verbosity}
NoFlag
pkg_descr
lbi'
@@ -316,9 +316,8 @@ repl pkg_descr lbi flags suffixes args = do
let clbi = targetCLBI target
comp = targetComponent target
lbi' = lbiForComponent comp lbi
- replFlags = replReplOptions flags
preBuildComponent verbosity lbi target
- replComponent replFlags verbosity pkg_descr lbi' suffixes comp clbi distPref
+ replComponent flags verbosity pkg_descr lbi' suffixes comp clbi distPref
-- | Start an interpreter without loading any package files.
startInterpreter
@@ -335,7 +334,7 @@ startInterpreter verbosity programDb comp platform packageDBs =
_ -> dieWithException verbosity REPLNotSupported
buildComponent
- :: Verbosity
+ :: BuildFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
@@ -344,12 +343,12 @@ buildComponent
-> ComponentLocalBuildInfo
-> FilePath
-> IO (Maybe InstalledPackageInfo)
-buildComponent verbosity _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
- dieWithException verbosity $ NoSupportBuildingTestSuite tt
-buildComponent verbosity _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =
- dieWithException verbosity $ NoSupportBuildingBenchMark tt
+buildComponent flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =
+ dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingTestSuite tt
+buildComponent flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =
+ dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingBenchMark tt
buildComponent
- verbosity
+ flags
numJobs
pkg_descr
lbi0
@@ -364,6 +363,7 @@ buildComponent
-- built.
distPref =
do
+ let verbosity = fromFlag $ buildVerbosity flags
pwd <- getCurrentDirectory
let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
@@ -378,7 +378,7 @@ buildComponent
(maybeComponentInstantiatedWith clbi)
let libbi = libBuildInfo lib
lib' = lib{libBuildInfo = addSrcDir (addExtraOtherModules libbi generatedExtras) genDir}
- buildLib verbosity numJobs pkg lbi lib' libClbi
+ buildLib flags numJobs pkg lbi lib' libClbi
-- NB: need to enable multiple instances here, because on 7.10+
-- the package name is the same as the library, and we still
-- want the registration to go through.
@@ -399,7 +399,7 @@ buildComponent
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
return Nothing -- Can't depend on test suite
buildComponent
- verbosity
+ flags
numJobs
pkg_descr
lbi
@@ -408,6 +408,7 @@ buildComponent
clbi
distPref =
do
+ let verbosity = fromFlag $ buildVerbosity flags
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras verbosity comp lbi
setupMessage'
@@ -430,7 +431,7 @@ buildComponent
libbi
}
- buildLib verbosity numJobs pkg_descr lbi lib' clbi
+ buildLib flags numJobs pkg_descr lbi lib' clbi
let oneComponentRequested (OneComponentRequestedSpec _) = True
oneComponentRequested _ = False
@@ -573,7 +574,7 @@ addSrcDir bi extra = bi{hsSourceDirs = new}
new = ordNub (unsafeMakeSymbolicPath extra : hsSourceDirs bi)
replComponent
- :: ReplOptions
+ :: ReplFlags
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
@@ -604,7 +605,7 @@ replComponent
extras <- preprocessExtras verbosity comp lbi
let libbi = libBuildInfo lib
lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
- replLib replFlags verbosity pkg lbi lib' libClbi
+ replLib replFlags pkg lbi lib' libClbi
replComponent
replFlags
verbosity
@@ -621,23 +622,23 @@ replComponent
CLib lib -> do
let libbi = libBuildInfo lib
lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}
- replLib replFlags verbosity pkg_descr lbi lib' clbi
+ replLib replFlags pkg_descr lbi lib' clbi
CFLib flib ->
- replFLib replFlags verbosity pkg_descr lbi flib clbi
+ replFLib replFlags pkg_descr lbi flib clbi
CExe exe -> do
let ebi = buildInfo exe
exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
- replExe replFlags verbosity pkg_descr lbi exe' clbi
+ replExe replFlags pkg_descr lbi exe' clbi
CTest test@TestSuite{testInterface = TestSuiteExeV10{}} -> do
let exe = testSuiteExeV10AsExe test
let ebi = buildInfo exe
exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
- replExe replFlags verbosity pkg_descr lbi exe' clbi
+ replExe replFlags pkg_descr lbi exe' clbi
CBench bm@Benchmark{benchmarkInterface = BenchmarkExeV10{}} -> do
let exe = benchmarkExeV10asExe bm
let ebi = buildInfo exe
exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}
- replExe replFlags verbosity pkg_descr lbi exe' clbi
+ replExe replFlags pkg_descr lbi exe' clbi
#if __GLASGOW_HASKELL__ < 811
-- silence pattern-match warnings prior to GHC 9.0
_ -> error "impossible"
@@ -822,20 +823,21 @@ addInternalBuildTools pkg lbi bi progs =
-- TODO: build separate libs in separate dirs so that we can build
-- multiple libs, e.g. for 'LibTest' library-style test suites
buildLib
- :: Verbosity
+ :: BuildFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
-buildLib verbosity numJobs pkg_descr lbi lib clbi =
- case compilerFlavor (compiler lbi) of
- GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
- GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
- UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
- HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
- _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
+buildLib flags numJobs pkg_descr lbi lib clbi =
+ let verbosity = fromFlag $ buildVerbosity flags
+ in case compilerFlavor (compiler lbi) of
+ GHC -> GHC.buildLib flags numJobs pkg_descr lbi lib clbi
+ GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
+ UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
+ HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
+ _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
-- | Build a foreign library
--
@@ -870,47 +872,48 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
_ -> dieWithException verbosity BuildingNotSupportedWithCompiler
replLib
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
-replLib replFlags verbosity pkg_descr lbi lib clbi =
- case compilerFlavor (compiler lbi) of
- -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
- -- NoFlag as the numJobs parameter.
- GHC -> GHC.replLib replFlags verbosity NoFlag pkg_descr lbi lib clbi
- GHCJS -> GHCJS.replLib (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi lib clbi
- _ -> dieWithException verbosity REPLNotSupported
+replLib replFlags pkg_descr lbi lib clbi =
+ let verbosity = fromFlag $ replVerbosity replFlags
+ opts = replReplOptions replFlags
+ in case compilerFlavor (compiler lbi) of
+ -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
+ -- NoFlag as the numJobs parameter.
+ GHC -> GHC.replLib replFlags NoFlag pkg_descr lbi lib clbi
+ GHCJS -> GHCJS.replLib (replOptionsFlags opts) verbosity NoFlag pkg_descr lbi lib clbi
+ _ -> dieWithException verbosity REPLNotSupported
replExe
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
-replExe replFlags verbosity pkg_descr lbi exe clbi =
- case compilerFlavor (compiler lbi) of
- GHC -> GHC.replExe replFlags verbosity NoFlag pkg_descr lbi exe clbi
- GHCJS -> GHCJS.replExe (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi exe clbi
- _ -> dieWithException verbosity REPLNotSupported
+replExe flags pkg_descr lbi exe clbi =
+ let verbosity = fromFlag $ replVerbosity flags
+ in case compilerFlavor (compiler lbi) of
+ GHC -> GHC.replExe flags NoFlag pkg_descr lbi exe clbi
+ GHCJS -> GHCJS.replExe (replOptionsFlags $ replReplOptions flags) verbosity NoFlag pkg_descr lbi exe clbi
+ _ -> dieWithException verbosity REPLNotSupported
replFLib
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
-replFLib replFlags verbosity pkg_descr lbi exe clbi =
- case compilerFlavor (compiler lbi) of
- GHC -> GHC.replFLib replFlags verbosity NoFlag pkg_descr lbi exe clbi
- _ -> dieWithException verbosity REPLNotSupported
+replFLib flags pkg_descr lbi exe clbi =
+ let verbosity = fromFlag $ replVerbosity flags
+ in case compilerFlavor (compiler lbi) of
+ GHC -> GHC.replFLib flags NoFlag pkg_descr lbi exe clbi
+ _ -> dieWithException verbosity REPLNotSupported
-- | Pre-build steps for a component: creates the autogenerated files
-- for a particular configured component.
diff --git a/Cabal/src/Distribution/Simple/Build/Inputs.hs b/Cabal/src/Distribution/Simple/Build/Inputs.hs
new file mode 100644
index 0000000000000000000000000000000000000000..48b3b60a12b7e1abfdc47e092634de0509c0fd58
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/Build/Inputs.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Distribution.Simple.Build.Inputs
+ ( -- * Inputs of actions for building components
+ PreBuildComponentInputs (..)
+
+ -- * Queries over the component being built
+ , buildVerbosity
+ , buildComponent
+ , buildIsLib
+ , buildCLBI
+ , buildBI
+ , buildCompiler
+
+ -- * Re-exports
+ , BuildingWhat (..)
+ , LocalBuildInfo (..)
+ , TargetInfo (..)
+ , buildingWhatVerbosity
+ , buildingWhatDistPref
+ )
+where
+
+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
+
+-- | The information required for a build computation which is available right
+-- before building each component, i.e. the pre-build component inputs.
+data PreBuildComponentInputs = PreBuildComponentInputs
+ { buildingWhat :: BuildingWhat
+ -- ^ What kind of build are we doing?
+ , localBuildInfo :: LocalBuildInfo
+ -- ^ Information about the package
+ , targetInfo :: TargetInfo
+ -- ^ Information about an individual component
+ }
+
+-- | Get the @'Verbosity'@ from the context the component being built is in.
+buildVerbosity :: PreBuildComponentInputs -> Verbosity
+buildVerbosity = buildingWhatVerbosity . buildingWhat
+
+-- | Get the @'Component'@ being built.
+buildComponent :: PreBuildComponentInputs -> Component
+buildComponent = targetComponent . targetInfo
+
+-- | Is the @'Component'@ being built a @'Library'@?
+buildIsLib :: PreBuildComponentInputs -> Bool
+buildIsLib = do
+ component <- buildComponent
+ let isLib
+ | CLib{} <- component = True
+ | otherwise = False
+ return isLib
+{-# INLINE buildIsLib #-}
+
+-- | Get the @'ComponentLocalBuildInfo'@ for the component being built.
+buildCLBI :: PreBuildComponentInputs -> ComponentLocalBuildInfo
+buildCLBI = targetCLBI . targetInfo
+
+-- | Get the @'BuildInfo'@ of the component being built.
+buildBI :: PreBuildComponentInputs -> BuildInfo
+buildBI = componentBuildInfo . buildComponent
+
+-- | Get the @'Compiler'@ being used to build the component.
+buildCompiler :: PreBuildComponentInputs -> Compiler
+buildCompiler = compiler . localBuildInfo
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 1a6d0d5d86dfa1a6b377e32818f28a4fa7a901dc..449dc695a6936fc7e6746ab426b0c38ef0c55511 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -56,8 +56,8 @@ module Distribution.Simple.GHC
, libAbiHash
, hcPkgInfo
, registerPackage
- , componentGhcOptions
- , componentCcGhcOptions
+ , Internal.componentGhcOptions
+ , Internal.componentCcGhcOptions
, getGhcAppDir
, getLibDir
, isDynamic
@@ -91,16 +91,13 @@ import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Package
import Distribution.PackageDescription as PD
import Distribution.Pretty
+import Distribution.Simple.Build.Inputs (PreBuildComponentInputs (..))
import Distribution.Simple.BuildPaths
import Distribution.Simple.Compiler
import Distribution.Simple.Errors
import Distribution.Simple.Flag (Flag (..), toFlag)
-import Distribution.Simple.GHC.Build
- ( componentGhcOptions
- , exeTargetName
- , flibTargetName
- , isDynamic
- )
+import qualified Distribution.Simple.GHC.Build as GHC
+import Distribution.Simple.GHC.Build.Utils
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.Simple.GHC.ImplInfo
import qualified Distribution.Simple.GHC.Internal as Internal
@@ -118,6 +115,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
@@ -137,13 +135,12 @@ import System.FilePath
)
import qualified System.Info
#ifndef mingw32_HOST_OS
-import Distribution.Simple.GHC.Build (flibBuildName)
import System.Directory (renameFile)
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
-import Distribution.Simple.GHC.BuildGeneric (GBuildMode (..), gbuild)
-import Distribution.Simple.GHC.BuildOrRepl (buildOrReplLib)
+import Distribution.Simple.Setup (BuildingWhat (..))
+import Distribution.Simple.Setup.Build
-- -----------------------------------------------------------------------------
-- Configuring
@@ -570,25 +567,28 @@ getInstalledPackagesMonitorFiles verbosity platform progdb =
-- Building a library
buildLib
- :: Verbosity
+ :: BuildFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
-buildLib = buildOrReplLib Nothing
+buildLib flags numJobs pkg lbi lib clbi =
+ GHC.build numJobs pkg $
+ PreBuildComponentInputs (BuildNormal flags) lbi (TargetInfo clbi (CLib lib))
replLib
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
-replLib = buildOrReplLib . Just
+replLib flags numJobs pkg lbi lib clbi =
+ GHC.build numJobs pkg $
+ PreBuildComponentInputs (BuildRepl flags) lbi (TargetInfo clbi (CLib lib))
-- | Start a REPL without loading any source files.
startInterpreter
@@ -620,19 +620,21 @@ buildFLib
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
-buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
+buildFLib v numJobs pkg lbi flib clbi =
+ GHC.build numJobs pkg $
+ PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib))
replFLib
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> ForeignLib
-> ComponentLocalBuildInfo
-> IO ()
-replFLib replFlags v njobs pkg lbi =
- gbuild v njobs pkg lbi . GReplFLib replFlags
+replFLib replFlags njobs pkg lbi flib clbi =
+ GHC.build njobs pkg $
+ PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib))
-- | Build an executable with GHC.
buildExe
@@ -643,19 +645,21 @@ buildExe
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
-buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
+buildExe v njobs pkg lbi exe clbi =
+ GHC.build njobs pkg $
+ PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe))
replExe
- :: ReplOptions
- -> Verbosity
+ :: ReplFlags
-> Flag ParStrat
-> PackageDescription
-> LocalBuildInfo
-> Executable
-> ComponentLocalBuildInfo
-> IO ()
-replExe replFlags v njobs pkg lbi =
- gbuild v njobs pkg lbi . GReplExe replFlags
+replExe replFlags njobs pkg lbi exe clbi =
+ GHC.build njobs pkg $
+ PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe))
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
@@ -672,7 +676,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
comp = compiler lbi
platform = hostPlatform lbi
vanillaArgs =
- (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
+ (Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty
{ ghcOptMode = toFlag GhcModeAbiHash
, ghcOptInputModules = toNubListR $ exposedModules lib
@@ -713,20 +717,6 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
return (takeWhile (not . isSpace) hash)
-componentCcGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
- -> GhcOptions
-componentCcGhcOptions verbosity lbi =
- Internal.componentCcGhcOptions verbosity implInfo lbi
- where
- comp = compiler lbi
- implInfo = getImplInfo comp
-
-- -----------------------------------------------------------------------------
-- Installing
@@ -753,7 +743,7 @@ installExe
exe = do
createDirectoryIfMissingVerbose verbosity True binDir
let exeName' = unUnqualComponentName $ exeName exe
- exeFileName = exeTargetName (hostPlatform lbi) exe
+ exeFileName = exeTargetName (hostPlatform lbi) (exeName exe)
fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
installBinary dest = do
installExecutableFile
diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs
index 4afd2a03a2f115ac56e3beef444524f20aa44d82..cc50e3bdb3cc43c47707e64435a1dd3190f5c2d0 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build.hs
@@ -1,262 +1,140 @@
-module Distribution.Simple.GHC.Build
- ( getRPaths
- , runReplOrWriteFlags
- , checkNeedsRecompilation
- , replNoLoad
- , componentGhcOptions
- , supportsDynamicToo
- , isDynamic
- , flibBuildName
- , flibTargetName
- , exeTargetName
- )
-where
+module Distribution.Simple.GHC.Build where
import Distribution.Compat.Prelude
import Prelude ()
-import qualified Data.ByteString.Lazy.Char8 as BS
-import Distribution.Compat.Binary (encode)
-import Distribution.Compat.ResponseFile (escapeArgs)
-import qualified Distribution.InstalledPackageInfo as IPI
-import Distribution.Package
-import Distribution.PackageDescription as PD
-import Distribution.PackageDescription.Utils (cabalBug)
-import Distribution.Pretty
-import Distribution.Simple.BuildPaths
-import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault)
-import Distribution.Simple.GHC.ImplInfo
-import qualified Distribution.Simple.GHC.Internal as Internal
+import Control.Monad.IO.Class
+import qualified Data.Set as Set
+import Distribution.PackageDescription as PD hiding (buildInfo)
+import Distribution.Simple.Build.Inputs
+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.GHC.Build.Utils (withDynFLib)
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
-import Distribution.Simple.Program.GHC
-import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
-import Distribution.System
-import Distribution.Utils.NubList
-import Distribution.Verbosity
-import Distribution.Version
-import System.Directory
- ( createDirectoryIfMissing
- , getCurrentDirectory
- )
+import Distribution.Types.ComponentLocalBuildInfo (componentIsIndefinite)
+import Distribution.Types.ParStrat
+import Distribution.Utils.NubList (fromNubListR)
+import System.Directory hiding (exeExtension)
import System.FilePath
- ( isRelative
- , replaceExtension
- , takeExtension
- , (<.>)
- , (</>)
- )
-exeTargetName :: Platform -> Executable -> String
-exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform
-
-withExt :: FilePath -> String -> FilePath
-withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else ""
-
--- | Target name for a foreign library (the actual file name)
---
--- We do not use mkLibName and co here because the naming for foreign libraries
--- is slightly different (we don't use "_p" or compiler version suffices, and we
--- don't want the "lib" prefix on Windows).
---
--- TODO: We do use `dllExtension` and co here, but really that's wrong: they
--- use the OS used to build cabal to determine which extension to use, rather
--- than the target OS (but this is wrong elsewhere in Cabal as well).
-flibTargetName :: LocalBuildInfo -> ForeignLib -> String
-flibTargetName lbi flib =
- case (os, foreignLibType flib) of
- (Windows, ForeignLibNativeShared) -> nm <.> "dll"
- (Windows, ForeignLibNativeStatic) -> nm <.> "lib"
- (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
- (_other, ForeignLibNativeShared) ->
- "lib" ++ nm <.> dllExtension (hostPlatform lbi)
- (_other, ForeignLibNativeStatic) ->
- "lib" ++ nm <.> staticLibExtension (hostPlatform lbi)
- (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
- where
- nm :: String
- nm = unUnqualComponentName $ foreignLibName flib
-
- os :: OS
- os =
- let (Platform _ os') = hostPlatform lbi
- in os'
-
- -- If a foreign lib foo has lib-version-info 5:1:2 or
- -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
- -- Libtool's version-info data is translated into library versions in a
- -- nontrivial way: so refer to libtool documentation.
- versionedExt :: String
- versionedExt =
- let nums = foreignLibVersion flib os
- in foldl (<.>) "so" (map show nums)
-
--- | Name for the library when building.
---
--- If the `lib-version-info` field or the `lib-version-linux` field of
--- a foreign library target is set, we need to incorporate that
--- version into the SONAME field.
---
--- If a foreign library foo has lib-version-info 5:1:2, it should be
--- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3.
--- However, GHC does not allow overriding soname by setting linker
--- options, as it sets a soname of its own (namely the output
--- filename), after the user-supplied linker options. Hence, we have
--- to compile the library with the soname as its filename. We rename
--- the compiled binary afterwards.
---
--- This method allows to adjust the name of the library at build time
--- such that the correct soname can be set.
-flibBuildName :: LocalBuildInfo -> ForeignLib -> String
-flibBuildName lbi flib
- -- On linux, if a foreign-library has version data, the first digit is used
- -- to produce the SONAME.
- | (os, foreignLibType flib)
- == (Linux, ForeignLibNativeShared) =
- let nums = foreignLibVersion flib os
- in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
- | otherwise = flibTargetName lbi flib
- where
- os :: OS
- os =
- let (Platform _ os') = hostPlatform lbi
- in os'
-
- nm :: String
- nm = unUnqualComponentName $ foreignLibName flib
-
-supportsDynamicToo :: Compiler -> Bool
-supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
-
-isDynamic :: Compiler -> Bool
-isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
-
-componentGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> FilePath
- -> GhcOptions
-componentGhcOptions verbosity lbi =
- Internal.componentGhcOptions verbosity implInfo lbi
- where
- comp = compiler lbi
- implInfo = getImplInfo comp
-
-replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
-replNoLoad replFlags l
- | replOptionsNoLoad replFlags == Flag True = mempty
- | otherwise = l
-
--- | Finds the object file name of the given source file
-getObjectFileName :: FilePath -> GhcOptions -> FilePath
-getObjectFileName filename opts = oname
- where
- odir = fromFlag (ghcOptObjDir opts)
- oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
- oname = odir </> replaceExtension filename oext
-
--- | Returns True if the modification date of the given source file is newer than
--- the object file we last compiled for it, or if no object file exists yet.
-checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
-checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
- where
- oname = getObjectFileName filename opts
-
--- | Calculate the RPATHs for the component we are building.
---
--- Calculates relative RPATHs when 'relocatable' is set.
-getRPaths
- :: LocalBuildInfo
- -> ComponentLocalBuildInfo
- -- ^ Component we are building
- -> IO (NubListR FilePath)
-getRPaths lbi clbi | supportRPaths hostOS = do
- libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi
- let hostPref = case hostOS of
- OSX -> "@loader_path"
- _ -> "$ORIGIN"
- relPath p = if isRelative p then hostPref </> p else p
- rpaths = toNubListR (map relPath libraryPaths)
- return rpaths
- where
- (Platform _ hostOS) = hostPlatform lbi
- compid = compilerId . compiler $ lbi
-
- -- The list of RPath-supported operating systems below reflects the
- -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
- -- reflect whether the OS supports RPATH.
-
- -- E.g. when this comment was written, the *BSD operating systems were
- -- untested with regards to Cabal RPATH handling, and were hence set to
- -- 'False', while those operating systems themselves do support RPATH.
- supportRPaths Linux = True
- supportRPaths Windows = False
- supportRPaths OSX = True
- supportRPaths FreeBSD =
- case compid of
- CompilerId GHC ver | ver >= mkVersion [7, 10, 2] -> True
- _ -> False
- supportRPaths OpenBSD = False
- supportRPaths NetBSD = False
- supportRPaths DragonFly = False
- supportRPaths Solaris = False
- supportRPaths AIX = False
- supportRPaths HPUX = False
- supportRPaths IRIX = False
- supportRPaths HaLVM = False
- supportRPaths IOS = False
- supportRPaths Android = False
- supportRPaths Ghcjs = False
- supportRPaths Wasi = False
- supportRPaths Hurd = True
- supportRPaths Haiku = False
- supportRPaths (OtherOS _) = False
--- Do _not_ add a default case so that we get a warning here when a new OS
--- is added.
-
-getRPaths _ _ = return mempty
-
-runReplOrWriteFlags
- :: Verbosity
- -> ConfiguredProgram
- -> Compiler
- -> Platform
- -> ReplOptions
- -> GhcOptions
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> PackageName
+{-
+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
+artifacts are put together.
+
+\* For executables or foreign libs, buildTargetDir == targetDir/<name-of-target-dir>-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)
+
+For instance, for a component `cabal-benchmarks`:
+ targetDir == <buildDir>/cabal-benchmarks
+ buildTargetDir == <buildDir>/cabal-benchmarks/cabal-benchmarks-tmp
+
+Or, for a library `Cabal`:
+ targetDir == <buildDir>/.
+ buildTargetDir == targetDir
+
+Furthermore, we need to account for the limit of characters in ghc
+invocations that different OSes constrain us to. Cabal invocations can
+rapidly reach this limit, in part, due to the long length of cabal v2
+prefixes. To minimize the likelihood, we use
+`makeRelativeToCurrentDirectory` to shorten the paths used in invocations
+(see da6321bb).
+
+However, in executables, we don't do this. It seems that we don't need to do it
+for executable-like components because the linking step, instead of passing as
+an argument the path to each module, it simply passes the module name, the sources dir, and --make.
+RM: I believe we can use --make + module names instead of paths-to-objects
+for linking libraries too (2024-01) (TODO)
+-}
+
+-- | The main build phase of building a component.
+-- Includes building Haskell modules, extra build sources, and linking.
+build
+ :: Flag ParStrat
+ -> PackageDescription
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
-> IO ()
-runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts bi clbi pkg_name =
- case replOptionsFlagOutput rflags of
- NoFlag -> runGHC verbosity ghcProg comp platform replOpts
- 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 (replOpts{ghcOptMode = NoFlag})
+build numJobs pkg_descr pbci = do
+ let
+ verbosity = buildVerbosity pbci
+ component = buildComponent pbci
+ isLib = buildIsLib pbci
+ lbi = localBuildInfo pbci
+ clbi = buildCLBI pbci
+
+ -- Create a few directories for building the component
+ -- 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/<name-of-target-dir>-tmp
+ | targetDirName : _ <- reverse $ splitDirectories targetDir_absolute =
+ targetDir_absolute </> (targetDirName ++ "-tmp")
+ | otherwise = error "GHC.build: targetDir is empty"
+
+ liftIO $ do
+ createDirectoryIfMissingVerbose verbosity True targetDir_absolute
+ createDirectoryIfMissingVerbose verbosity True buildTargetDir_absolute
+
+ -- See Note [Build Target Dir vs Target Dir] as well
+ _targetDir <- liftIO $ makeRelativeToCurrentDirectory targetDir_absolute
+ buildTargetDir <-
+ -- To preserve the previous behaviour, we don't use relative dirs for
+ -- executables. Historically, this isn't needed to reduce the CLI limit
+ -- (unlike for libraries) because we link executables with the module names
+ -- instead of passing the path to object file -- that's something else we
+ -- can now fix after the refactor lands.
+ if isLib
+ then liftIO $ makeRelativeToCurrentDirectory buildTargetDir_absolute
+ else return buildTargetDir_absolute
+
+ (ghcProg, _) <- liftIO $ requireProgram verbosity ghcProgram (withPrograms lbi)
+
+ -- Determine in which ways we want to build the component
+ let
+ wantVanilla = if isLib then withVanillaLib lbi else False
+ -- Arguably, wantStatic should be "withFullyStaticExe lbi" for executables,
+ -- but it was not before the refactor.
+ wantStatic = if isLib then withStaticLib lbi else not (wantDynamic || wantProf)
+ wantDynamic = case component of
+ CLib{} -> withSharedLib lbi
+ CFLib flib -> withDynFLib flib
+ CExe{} -> withDynExe lbi
+ CTest{} -> withDynExe lbi
+ CBench{} -> withDynExe 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
+ -- We build static by default if no other way is wanted.
+ -- For executables and foreign libraries, there should only be one wanted way.
+ wantedWays =
+ Set.fromList $
+ -- If building a library, we accumulate all the ways,
+ -- otherwise, we take just one.
+ (if isLib then id else take 1) $
+ [ProfWay | wantProf]
+ -- I don't see why we shouldn't build with dynamic
+ -- indefinite components.
+ <> [DynWay | wantDynamic && not (componentIsIndefinite clbi)]
+ <> [StaticWay | wantStatic || wantVanilla || not (wantDynamic || wantProf)]
+
+ liftIO $ info verbosity ("Wanted build ways: " ++ show (Set.toList wantedWays))
+
+ -- 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, #3294).
+ buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays pbci
+ extraSources <- buildAllExtraSources ghcProg buildTargetDir pbci
+ linkOrLoadComponent ghcProg pkg_descr (fromNubListR extraSources) (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts) pbci
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
new file mode 100644
index 0000000000000000000000000000000000000000..07ad6ac31d8d2d6e05eba84d2cef00e98111b644
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Distribution.Simple.GHC.Build.ExtraSources where
+
+import Control.Monad
+import Data.Foldable
+import Distribution.Simple.Flag
+import qualified Distribution.Simple.GHC.Internal as Internal
+import Distribution.Simple.Program.GHC
+import Distribution.Simple.Utils
+import Distribution.Utils.NubList
+
+import Distribution.Types.BuildInfo
+import Distribution.Types.Component
+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.Executable
+import Distribution.Verbosity (Verbosity)
+
+import Distribution.Simple.Build.Inputs
+
+-- | 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
+ -> FilePath
+ -- ^ The build directory for this target
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (NubListR FilePath)
+ -- ^ Returns the (nubbed) list of extra sources that were built
+buildAllExtraSources =
+ mconcat
+ [ buildCSources
+ , buildCxxSources
+ , buildJsSources
+ , buildAsmSources
+ , buildCmmSources
+ ]
+
+buildCSources
+ , buildCxxSources
+ , buildJsSources
+ , buildAsmSources
+ , buildCmmSources
+ :: ConfiguredProgram
+ -- ^ The GHC configured program
+ -> FilePath
+ -- ^ The build directory for this target
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (NubListR FilePath)
+ -- ^ Returns the list of extra sources that were built
+buildCSources =
+ buildExtraSources
+ "C Sources"
+ Internal.componentCcGhcOptions
+ True
+ ( \c ->
+ cSources (componentBuildInfo c)
+ ++ case c of
+ CExe exe | isC (modulePath exe) -> [modulePath exe]
+ _otherwise -> []
+ )
+buildCxxSources =
+ buildExtraSources
+ "C++ Sources"
+ Internal.componentCxxGhcOptions
+ True
+ ( \c ->
+ cxxSources (componentBuildInfo c)
+ ++ case c of
+ CExe exe | isCxx (modulePath exe) -> [modulePath exe]
+ _otherwise -> []
+ )
+buildJsSources ghcProg buildTargetDir = do
+ Platform hostArch _ <- hostPlatform <$> localBuildInfo
+ let hasJsSupport = hostArch == JavaScript
+ buildExtraSources
+ "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
+ )
+ ghcProg
+ buildTargetDir
+buildAsmSources =
+ buildExtraSources
+ "Assembler Sources"
+ Internal.componentAsmGhcOptions
+ True
+ (asmSources . componentBuildInfo)
+buildCmmSources =
+ buildExtraSources
+ "C-- Sources"
+ Internal.componentCmmGhcOptions
+ True
+ (cmmSources . componentBuildInfo)
+
+-- | Create 'PreBuildComponentRules' for a given type of extra build sources
+-- which are compiled via a GHC invocation with the given options. Used to
+-- define built-in extra sources, such as, C, Cxx, Js, Asm, and Cmm sources.
+buildExtraSources
+ :: String
+ -- ^ String describing the extra sources being built, for printing.
+ -> (Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> GhcOptions)
+ -- ^ Function to determine the @'GhcOptions'@ for the
+ -- invocation of GHC when compiling these extra sources (e.g.
+ -- @'Internal.componentCxxGhcOptions'@,
+ -- @'Internal.componentCmmGhcOptions'@)
+ -> Bool
+ -- ^ Some types of build sources should not be built in the dynamic way, namely, JS sources.
+ -- I'm not entirely sure this remains true after we migrate to supporting GHC's JS backend rather than GHCJS.
+ -- Boolean for "do we allow building these sources the dynamic way?"
+ -> (Component -> [FilePath])
+ -- ^ View the extra sources of a component, typically from
+ -- the build info (e.g. @'asmSources'@, @'cSources'@).
+ -- @'Executable'@ components might additionally add the
+ -- program entry point (@main-is@ file) to the extra sources,
+ -- if it should be compiled as the rest of them.
+ -> ConfiguredProgram
+ -- ^ The GHC configured program
+ -> FilePath
+ -- ^ The build directory for this target
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (NubListR FilePath)
+ -- ^ Returns the list of extra sources that were built
+buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir =
+ \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->
+ let
+ bi = componentBuildInfo (targetComponent targetInfo)
+ verbosity = buildingWhatVerbosity buildingWhat
+ clbi = targetCLBI targetInfo
+
+ sources = viewSources (targetComponent targetInfo)
+
+ comp = compiler lbi
+ platform = hostPlatform lbi
+ -- Instead of keeping this logic here, we really just want to
+ -- receive as an input the `neededWays` from GHC/Build.build and build
+ -- accordingly, since we've already determined the extra needed ways
+ -- needed for e.g. template haskell. Although we'd have to account for 'wantDyn'.
+ isGhcDynamic = isDynamic comp
+ doingTH = usesTemplateHaskellOrQQ bi
+ forceSharedLib = doingTH && isGhcDynamic
+ runGhcProg = runGHC verbosity ghcProg comp platform
+
+ buildAction sourceFile = do
+ let baseSrcOpts =
+ componentSourceGhcOptions
+ verbosity
+ lbi
+ bi
+ clbi
+ buildTargetDir
+ sourceFile
+ vanillaSrcOpts
+ -- Dynamic GHC requires C sources to be built
+ -- with -fPIC for REPL to work. See #2207.
+ | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True}
+ | otherwise = baseSrcOpts
+ profSrcOpts =
+ vanillaSrcOpts
+ `mappend` mempty
+ { ghcOptProfilingMode = toFlag True
+ }
+ sharedSrcOpts =
+ vanillaSrcOpts
+ `mappend` mempty
+ { ghcOptFPic = toFlag True
+ , ghcOptDynLinkMode = toFlag GhcDynamicOnly
+ }
+ -- TODO: Placing all Haskell, C, & C++ objects in a single directory
+ -- Has the potential for file collisions. In general we would
+ -- consider this a user error. However, we should strive to
+ -- add a warning if this occurs.
+ odir = fromFlag (ghcOptObjDir vanillaSrcOpts)
+ compileIfNeeded opts = do
+ needsRecomp <- checkNeedsRecompilation sourceFile opts
+ when needsRecomp $ runGhcProg opts
+
+ -- TODO: This whole section can be streamlined to the
+ -- wantedWays+neededWays logic used in Build/Modules.hs
+ createDirectoryIfMissingVerbose verbosity True odir
+ case targetComponent targetInfo of
+ -- For libraries, we compile extra objects in the three ways: vanilla, shared, and profiled.
+ -- We suffix shared objects with .dyn_o and profiled ones with .p_o.
+ CLib _lib
+ -- Unless for repl, in which case we only need the vanilla way
+ | BuildRepl _ <- buildingWhat ->
+ compileIfNeeded vanillaSrcOpts
+ | otherwise ->
+ do
+ compileIfNeeded vanillaSrcOpts
+ when (wantDyn && (forceSharedLib || withSharedLib lbi)) $
+ compileIfNeeded sharedSrcOpts{ghcOptObjSuffix = toFlag "dyn_o"}
+ when (withProfLib lbi) $
+ compileIfNeeded profSrcOpts{ghcOptObjSuffix = toFlag "p_o"}
+
+ -- For foreign libraries, we determine with which options to build the
+ -- objects (vanilla vs shared vs profiled)
+ CFLib flib
+ | withProfExe lbi -> -- It doesn't sound right to query "ProfExe" for a foreign library...
+ compileIfNeeded profSrcOpts
+ | withDynFLib flib && wantDyn ->
+ compileIfNeeded sharedSrcOpts
+ | otherwise ->
+ compileIfNeeded vanillaSrcOpts
+ -- For the remaining component types (Exec, Test, Bench), we also
+ -- determine with which options to build the objects (vanilla vs shared vs
+ -- profiled), but predicate is the same for the three kinds.
+ _exeLike
+ | withProfExe lbi ->
+ compileIfNeeded profSrcOpts
+ | withDynExe lbi && wantDyn ->
+ compileIfNeeded sharedSrcOpts
+ | otherwise ->
+ compileIfNeeded vanillaSrcOpts
+ in
+ -- build any sources
+ if (null sources || componentIsIndefinite clbi)
+ then return mempty
+ else do
+ info verbosity ("Building " ++ description ++ "...")
+ traverse_ buildAction sources
+ return (toNubListR sources)
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ab80a1522685f880e35b3e6f7a9ef85ba95c5ace
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -0,0 +1,662 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Distribution.Simple.GHC.Build.Link where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Control.Exception (assert)
+import Control.Monad (forM_)
+import Control.Monad.IO.Class
+import qualified Data.ByteString.Lazy.Char8 as BS
+import qualified Data.Set as Set
+import Distribution.Compat.Binary (encode)
+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
+import Distribution.PackageDescription as PD
+import Distribution.PackageDescription.Utils (cabalBug)
+import Distribution.Pretty
+import Distribution.Simple.Build.Inputs
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.Compiler
+import Distribution.Simple.GHC.Build.Modules
+import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName, withDynFLib)
+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
+
+-- | 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
+ -> (Set.Set BuildWay, BuildWay -> GhcOptions)
+ -- ^ The set of build ways wanted based on the user opts, and a function to
+ -- convert a build way into the set of ghc options that were used to build
+ -- that way.
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO ()
+linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (wantedWays, buildOpts) pbci = do
+ let
+ verbosity = buildVerbosity pbci
+ target = targetInfo pbci
+ component = buildComponent pbci
+ what = buildingWhat pbci
+ lbi = localBuildInfo pbci
+ bi = buildBI pbci
+ clbi = buildCLBI pbci
+
+ -- ensure extra lib dirs exist before passing to ghc
+ cleanedExtraLibDirs <- liftIO $ filterM doesDirectoryExist (extraLibDirs bi)
+ cleanedExtraLibDirsStatic <- liftIO $ filterM doesDirectoryExist (extraLibDirsStatic bi)
+
+ let
+ extraSourcesObjs = map (`replaceExtension` objExtension) extraSources
+
+ -- TODO: Shouldn't we use withStaticLib for libraries and something else
+ -- for foreign libs in the three cases where we use `withFullyStaticExe` below?
+ linkerOpts rpaths =
+ mempty
+ { ghcOptLinkOptions =
+ PD.ldOptions bi
+ ++ [ "-static"
+ | withFullyStaticExe lbi
+ ]
+ -- Pass extra `ld-options` given
+ -- through to GHC's linker.
+ ++ maybe
+ []
+ programOverrideArgs
+ (lookupProgram ldProgram (withPrograms lbi))
+ , ghcOptLinkLibs =
+ if withFullyStaticExe lbi
+ then extraLibsStatic bi
+ else extraLibs bi
+ , ghcOptLinkLibPath =
+ toNubListR $
+ if withFullyStaticExe lbi
+ then cleanedExtraLibDirsStatic
+ else cleanedExtraLibDirs
+ , ghcOptLinkFrameworks = toNubListR $ PD.frameworks bi
+ , ghcOptLinkFrameworkDirs = toNubListR $ PD.extraFrameworkDirs bi
+ , ghcOptInputFiles = toNubListR [buildTargetDir </> x | x <- extraSourcesObjs]
+ , ghcOptNoLink = Flag False
+ , ghcOptRPaths = rpaths
+ }
+ case what of
+ BuildRepl replFlags -> liftIO $ do
+ let
+ -- For repl we use the vanilla (static) ghc options
+ staticOpts = buildOpts StaticWay
+ replOpts =
+ staticOpts
+ { -- Repl options use Static as the base, but doesn't need to pass -static.
+ -- However, it maybe should, for uniformity.
+ ghcOptDynLinkMode = NoFlag
+ , ghcOptExtra =
+ Internal.filterGhciFlags
+ (ghcOptExtra staticOpts)
+ <> replOptionsFlags (replReplOptions replFlags)
+ , ghcOptInputModules = replNoLoad (replReplOptions replFlags) (ghcOptInputModules staticOpts)
+ , ghcOptInputFiles = replNoLoad (replReplOptions replFlags) (ghcOptInputFiles staticOpts)
+ }
+ -- For a normal compile we do separate invocations of ghc for
+ -- compiling as for linking. But for repl we have to do just
+ -- the one invocation, so that one has to include all the
+ -- linker stuff too, like -l flags and any .o files from C
+ -- files etc.
+ --
+ -- TODO: The repl doesn't use the runtime paths from linkerOpts
+ -- (ghcOptRPaths), which looks like a bug. After the refactor we
+ -- can fix this.
+ `mappend` linkerOpts mempty
+ `mappend` mempty
+ { ghcOptMode = toFlag GhcModeInteractive
+ , ghcOptOptimisation = toFlag GhcNoOptimisation
+ }
+
+ -- TODO: problem here is we need the .c files built first, so we can load them
+ -- with ghci, but .c files can depend on .h files generated by ghc by ffi
+ -- 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
+ -- If not building dynamically, we don't pass any runtime paths.
+ rpaths <- if DynWay `Set.member` wantedWays then getRPaths pbci else return (toNubListR [])
+ liftIO $ do
+ info verbosity "Linking..."
+ let linkExeLike name = linkExecutable (linkerOpts rpaths) (wantedWays, buildOpts) targetDir name runGhcProg lbi
+ case component of
+ CLib lib -> linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWays
+ CFLib flib -> linkFLib flib bi lbi (linkerOpts rpaths) (wantedWays, buildOpts) targetDir runGhcProg
+ CExe exe -> linkExeLike (exeName exe)
+ CTest test -> linkExeLike (testName test)
+ CBench bench -> linkExeLike (benchmarkName bench)
+
+-- | Link a library component
+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
+ -> Set.Set BuildWay
+ -- ^ Wanted build ways and corresponding build options
+ -> IO ()
+linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg lib lbi clbi extraSources rpaths wantedWays = do
+ let
+ compiler_id = compilerId comp
+ comp = compiler lbi
+ ghcVersion = compilerVersion comp
+ implInfo = getImplInfo comp
+ uid = componentUnitId clbi
+ libBi = libBuildInfo lib
+ Platform _hostArch hostOS = hostPlatform lbi
+ vanillaLibFilePath = buildTargetDir </> mkLibName uid
+ profileLibFilePath = buildTargetDir </> mkProfLibName uid
+ sharedLibFilePath =
+ buildTargetDir
+ </> mkSharedLibName (hostPlatform lbi) compiler_id uid
+ staticLibFilePath =
+ buildTargetDir
+ </> mkStaticLibName (hostPlatform lbi) compiler_id uid
+ ghciLibFilePath = buildTargetDir </> Internal.mkGHCiLibName uid
+ ghciProfLibFilePath = buildTargetDir </> Internal.mkGHCiProfLibName uid
+ libInstallPath =
+ libdir $
+ absoluteComponentInstallDirs
+ pkg_descr
+ lbi
+ uid
+ NoCopyDest
+ sharedLibInstallPath =
+ libInstallPath
+ </> mkSharedLibName (hostPlatform lbi) compiler_id uid
+
+ getObjFiles way =
+ mconcat
+ [ 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
+ ]
+ ]
+
+ -- I'm fairly certain that, just like the executable, we can keep just the
+ -- module input list, and point to the right sources dir (as is already
+ -- done), and GHC will pick up the right suffix (p_ for profile, dyn_ when
+ -- -shared...). The downside to doing this is that GHC would have to
+ -- reconstruct the module graph again.
+ -- That would mean linking the lib would be just like the executable, and
+ -- we could more easily merge the two.
+ --
+ -- Right now, instead, we pass the path to each object file.
+ ghcBaseLinkArgs =
+ mempty
+ { -- TODO: This basically duplicates componentGhcOptions.
+ -- I think we want to do the same as we do for executables: re-use the
+ -- base options, and link by module names, not object paths.
+ ghcOptExtra = hcStaticOptions GHC libBi
+ , ghcOptHideAllPackages = toFlag True
+ , ghcOptNoAutoLinkPackages = toFlag True
+ , ghcOptPackageDBs = withPackageDB lbi
+ , ghcOptThisUnitId = case clbi of
+ LibComponentLocalBuildInfo{componentCompatPackageKey = pk} ->
+ toFlag pk
+ _ -> mempty
+ , ghcOptThisComponentId = case clbi of
+ LibComponentLocalBuildInfo
+ { componentInstantiatedWith = insts
+ } ->
+ if null insts
+ then mempty
+ else toFlag (componentComponentId clbi)
+ _ -> mempty
+ , ghcOptInstantiatedWith = case clbi of
+ LibComponentLocalBuildInfo
+ { componentInstantiatedWith = insts
+ } ->
+ insts
+ _ -> []
+ , ghcOptPackages =
+ toNubListR $
+ Internal.mkGhcOptPackages mempty clbi
+ }
+
+ -- After the relocation lib is created we invoke ghc -shared
+ -- with the dependencies spelled out as -package arguments
+ -- and ghc invokes the linker with the proper library paths
+ ghcSharedLinkArgs dynObjectFiles =
+ ghcBaseLinkArgs
+ { ghcOptShared = toFlag True
+ , ghcOptDynLinkMode = toFlag GhcDynamicOnly
+ , ghcOptInputFiles = toNubListR dynObjectFiles
+ , ghcOptOutputFile = toFlag sharedLibFilePath
+ , -- For dynamic libs, Mac OS/X needs to know the install location
+ -- at build time. This only applies to GHC < 7.8 - see the
+ -- discussion in #1660.
+ ghcOptDylibName =
+ if hostOS == OSX
+ && ghcVersion < mkVersion [7, 8]
+ then toFlag sharedLibInstallPath
+ else mempty
+ , ghcOptLinkLibs = extraLibs libBi
+ , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
+ , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
+ , ghcOptLinkFrameworkDirs =
+ toNubListR $ PD.extraFrameworkDirs libBi
+ , ghcOptRPaths = rpaths
+ }
+ ghcStaticLinkArgs staticObjectFiles =
+ ghcBaseLinkArgs
+ { ghcOptStaticLib = toFlag True
+ , ghcOptInputFiles = toNubListR staticObjectFiles
+ , ghcOptOutputFile = toFlag staticLibFilePath
+ , ghcOptLinkLibs = extraLibs libBi
+ , -- TODO: Shouldn't this use cleanedExtraLibDirsStatic instead?
+ ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
+ }
+
+ staticObjectFiles <- getObjFiles StaticWay
+ profObjectFiles <- getObjFiles ProfWay
+ dynamicObjectFiles <- getObjFiles DynWay
+
+ let
+ linkWay = \case
+ ProfWay -> do
+ Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
+ when (withGHCiLib lbi) $ do
+ (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
+ Ld.combineObjectFiles
+ verbosity
+ lbi
+ ldProg
+ ghciProfLibFilePath
+ profObjectFiles
+ DynWay -> do
+ runGhcProg $ ghcSharedLinkArgs dynamicObjectFiles
+ StaticWay -> do
+ when (withVanillaLib lbi) $ do
+ Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
+ when (withGHCiLib lbi) $ do
+ (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
+ Ld.combineObjectFiles
+ verbosity
+ lbi
+ ldProg
+ ghciLibFilePath
+ staticObjectFiles
+ when (withStaticLib lbi) $ do
+ runGhcProg $ ghcStaticLinkArgs staticObjectFiles
+
+ -- ROMES: Why exactly branch on staticObjectFiles, rather than any other build
+ -- kind that we might have wanted instead?
+ -- This would be simpler by not adding every object to the invocation, and
+ -- rather using module names.
+ unless (null staticObjectFiles) $ do
+ info verbosity (show (ghcOptPackages (Internal.componentGhcOptions verbosity lbi libBi clbi buildTargetDir)))
+ traverse_ linkWay wantedWays
+
+-- | Link the executable resulting from building this component, be it an
+-- executable, test, or benchmark component.
+linkExecutable
+ :: (GhcOptions)
+ -- ^ The linker-specific GHC options
+ -> (Set.Set BuildWay, 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 (wantedWays, buildOpts) targetDir targetName runGhcProg lbi = do
+ -- When building an executable, we should only "want" one build way.
+ assert (Set.size wantedWays == 1) $
+ forM_ wantedWays $ \way -> do
+ let baseOpts = buildOpts way
+ linkOpts =
+ baseOpts
+ `mappend` linkerOpts
+ `mappend` mempty
+ { -- If there are no input Haskell files we pass -no-hs-main, and
+ -- assume there is a main function in another non-haskell object
+ ghcOptLinkNoHsMain = toFlag (ghcOptInputFiles baseOpts == mempty && ghcOptInputScripts baseOpts == mempty)
+ }
+ comp = compiler lbi
+
+ -- Work around old GHCs not relinking in this
+ -- situation, see #3294
+ let target = targetDir </> exeTargetName (hostPlatform lbi) targetName
+ when (compilerVersion comp < mkVersion [7, 7]) $ do
+ e <- doesFileExist target
+ when e (removeFile target)
+ runGhcProg linkOpts{ghcOptOutputFile = toFlag target}
+
+-- | Link a foreign library component
+linkFLib
+ :: ForeignLib
+ -> BuildInfo
+ -> LocalBuildInfo
+ -> (GhcOptions)
+ -- ^ The linker-specific GHC options
+ -> (Set.Set BuildWay, 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 (wantedWays, buildOpts) targetDir runGhcProg = do
+ let
+ comp = compiler lbi
+
+ -- Instruct GHC to link against libHSrts.
+ rtsLinkOpts :: GhcOptions
+ rtsLinkOpts
+ | supportsFLinkRts =
+ mempty
+ { ghcOptLinkRts = toFlag True
+ }
+ | otherwise =
+ mempty
+ { ghcOptLinkLibs = rtsOptLinkLibs
+ , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
+ }
+ where
+ threaded = hasThreaded bi
+ supportsFLinkRts = compilerVersion comp >= mkVersion [9, 0]
+ rtsInfo = extractRtsInfo lbi
+ rtsOptLinkLibs =
+ [ if withDynFLib flib
+ then
+ if threaded
+ then dynRtsThreadedLib (rtsDynamicInfo rtsInfo)
+ else dynRtsVanillaLib (rtsDynamicInfo rtsInfo)
+ else
+ if threaded
+ then statRtsThreadedLib (rtsStaticInfo rtsInfo)
+ else statRtsVanillaLib (rtsStaticInfo rtsInfo)
+ ]
+
+ linkOpts :: BuildWay -> GhcOptions
+ linkOpts way = case foreignLibType flib of
+ ForeignLibNativeShared ->
+ (buildOpts way)
+ `mappend` linkerOpts
+ `mappend` rtsLinkOpts
+ `mappend` mempty
+ { ghcOptLinkNoHsMain = toFlag True
+ , ghcOptShared = toFlag True
+ , ghcOptFPic = toFlag True
+ , ghcOptLinkModDefFiles = toNubListR $ foreignLibModDefFile flib
+ }
+ ForeignLibNativeStatic ->
+ -- this should be caught by buildFLib
+ -- (and if we do implement this, we probably don't even want to call
+ -- ghc here, but rather Ar.createArLibArchive or something)
+ cabalBug "static libraries not yet implemented"
+ ForeignLibTypeUnknown ->
+ cabalBug "unknown foreign lib type"
+ -- We build under a (potentially) different filename to set a
+ -- soname on supported platforms. See also the note for
+ -- @flibBuildName@.
+ let buildName = flibBuildName lbi flib
+ -- There should not be more than one wanted way when building an flib
+ assert (Set.size wantedWays == 1) $
+ forM_ wantedWays $ \way -> do
+ runGhcProg (linkOpts way){ghcOptOutputFile = toFlag (targetDir </> buildName)}
+ renameFile (targetDir </> buildName) (targetDir </> flibTargetName lbi flib)
+
+-- | Calculate the RPATHs for the component we are building.
+--
+-- Calculates relative RPATHs when 'relocatable' is set.
+getRPaths
+ :: PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (NubListR FilePath)
+getRPaths pbci = do
+ let
+ lbi = localBuildInfo pbci
+ bi = buildBI pbci
+ clbi = buildCLBI pbci
+
+ (Platform _ hostOS) = hostPlatform lbi
+ compid = compilerId . compiler $ lbi
+
+ -- The list of RPath-supported operating systems below reflects the
+ -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
+ -- reflect whether the OS supports RPATH.
+
+ -- E.g. when this comment was written, the *BSD operating systems were
+ -- untested with regards to Cabal RPATH handling, and were hence set to
+ -- 'False', while those operating systems themselves do support RPATH.
+ supportRPaths Linux = True
+ supportRPaths Windows = False
+ supportRPaths OSX = True
+ supportRPaths FreeBSD =
+ case compid of
+ CompilerId GHC ver | ver >= mkVersion [7, 10, 2] -> True
+ _ -> False
+ supportRPaths OpenBSD = False
+ supportRPaths NetBSD = False
+ supportRPaths DragonFly = False
+ supportRPaths Solaris = False
+ supportRPaths AIX = False
+ supportRPaths HPUX = False
+ supportRPaths IRIX = False
+ supportRPaths HaLVM = False
+ supportRPaths IOS = False
+ supportRPaths Android = False
+ supportRPaths Ghcjs = False
+ supportRPaths Wasi = False
+ supportRPaths Hurd = True
+ supportRPaths Haiku = False
+ supportRPaths (OtherOS _) = False
+ -- Do _not_ add a default case so that we get a warning here when a new OS
+ -- is added.
+
+ if supportRPaths hostOS
+ then do
+ libraryPaths <- liftIO $ depLibraryPaths False (relocatable lbi) lbi clbi
+ let hostPref = case hostOS of
+ OSX -> "@loader_path"
+ _ -> "$ORIGIN"
+ relPath p = if isRelative p then hostPref </> p else p
+ rpaths = toNubListR (map relPath libraryPaths) <> toNubListR (extraLibDirs bi)
+ return rpaths
+ else return mempty
+
+data DynamicRtsInfo = DynamicRtsInfo
+ { dynRtsVanillaLib :: FilePath
+ , dynRtsThreadedLib :: FilePath
+ , dynRtsDebugLib :: FilePath
+ , dynRtsEventlogLib :: FilePath
+ , dynRtsThreadedDebugLib :: FilePath
+ , dynRtsThreadedEventlogLib :: FilePath
+ }
+
+data StaticRtsInfo = StaticRtsInfo
+ { statRtsVanillaLib :: FilePath
+ , statRtsThreadedLib :: FilePath
+ , statRtsDebugLib :: FilePath
+ , statRtsEventlogLib :: FilePath
+ , statRtsThreadedDebugLib :: FilePath
+ , statRtsThreadedEventlogLib :: FilePath
+ , statRtsProfilingLib :: FilePath
+ , statRtsThreadedProfilingLib :: FilePath
+ }
+
+data RtsInfo = RtsInfo
+ { rtsDynamicInfo :: DynamicRtsInfo
+ , rtsStaticInfo :: StaticRtsInfo
+ , rtsLibPaths :: [FilePath]
+ }
+
+-- | Extract (and compute) information about the RTS library
+--
+-- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
+-- find this information somewhere. We can lookup the 'hsLibraries' field of
+-- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
+-- doesn't really help.
+extractRtsInfo :: LocalBuildInfo -> RtsInfo
+extractRtsInfo lbi =
+ case PackageIndex.lookupPackageName
+ (installedPkgs lbi)
+ (mkPackageName "rts") of
+ [(_, [rts])] -> aux rts
+ _otherwise -> error "No (or multiple) ghc rts package is registered"
+ where
+ aux :: InstalledPackageInfo -> RtsInfo
+ aux rts =
+ RtsInfo
+ { rtsDynamicInfo =
+ DynamicRtsInfo
+ { dynRtsVanillaLib = withGhcVersion "HSrts"
+ , dynRtsThreadedLib = withGhcVersion "HSrts_thr"
+ , dynRtsDebugLib = withGhcVersion "HSrts_debug"
+ , dynRtsEventlogLib = withGhcVersion "HSrts_l"
+ , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug"
+ , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l"
+ }
+ , rtsStaticInfo =
+ StaticRtsInfo
+ { statRtsVanillaLib = "HSrts"
+ , statRtsThreadedLib = "HSrts_thr"
+ , statRtsDebugLib = "HSrts_debug"
+ , statRtsEventlogLib = "HSrts_l"
+ , statRtsThreadedDebugLib = "HSrts_thr_debug"
+ , statRtsThreadedEventlogLib = "HSrts_thr_l"
+ , statRtsProfilingLib = "HSrts_p"
+ , statRtsThreadedProfilingLib = "HSrts_thr_p"
+ }
+ , rtsLibPaths = InstalledPackageInfo.libraryDirs rts
+ }
+ withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi))))
+
+-- | Determine whether the given 'BuildInfo' is intended to link against the
+-- threaded RTS. This is used to determine which RTS to link against when
+-- building a foreign library with a GHC without support for @-flink-rts@.
+hasThreaded :: BuildInfo -> Bool
+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
+ :: ConfiguredProgram
+ -> LocalBuildInfo
+ -> ReplFlags
+ -> GhcOptions
+ -> PackageName
+ -> TargetInfo
+ -> IO ()
+runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
+ let bi = componentBuildInfo $ targetComponent 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})
+
+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
new file mode 100644
index 0000000000000000000000000000000000000000..0a6c408ee4bf1c01eb84596a65535fb415fe93d5
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
@@ -0,0 +1,352 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
+
+module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..), buildWayPrefix) where
+
+import Control.Monad.IO.Class
+import Distribution.Compat.Prelude
+
+import Data.List (sortOn, (\\))
+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.Inputs
+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.LocalBuildInfo
+import Distribution.Simple.Program.GHC
+import Distribution.Simple.Program.Types
+import Distribution.Simple.Setup.Common
+import Distribution.Simple.Utils
+import Distribution.Types.Benchmark
+import Distribution.Types.BenchmarkInterface
+import Distribution.Types.BuildInfo
+import Distribution.Types.Executable
+import Distribution.Types.ForeignLib
+import Distribution.Types.PackageName.Magic
+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]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are multiple ways in which we may want to build our Haskell modules:
+ * The static way (-static)
+ * The dynamic/shared way (-dynamic)
+ * The profiled way (-prof)
+
+For libraries, we may /want/ to build modules in all three ways, or in any combination, depending on user options.
+For executables, we just /want/ to build the executable in the requested way.
+
+In practice, however, we may /need/ to build modules in additional ways beyonds the ones that were requested.
+This can happen because of Template Haskell.
+
+When we're using Template Haskell, we /need/ to additionally build modules with
+the used GHC's default/vanilla ABI. This is because the code that TH needs to
+run at compile time needs to be the vanilla ABI so it can be loaded up and run
+by the compiler. With dynamic-by-default GHC the TH object files loaded at
+compile-time need to be .dyn_o instead of .o.
+
+ * If the GHC is dynamic by default, that means we may need to also build
+ the dynamic way in addition the wanted way.
+
+ * If the GHC is static by default, we may need to build statically additionally.
+
+Of course, if the /wanted/ way is the way additionally /needed/ for TH, we don't need to do extra work.
+
+If it turns out that in the end we need to build both statically and
+dynamically, we want to make use of GHC's -static -dynamic-too capability, which
+builds modules in the two ways in a single invocation.
+
+If --dynamic-too is not supported by the GHC, then we need to be careful about
+the order in which modules are built. Specifically, we must first build the
+modules for TH with the vanilla ABI, and only afterwards the desired
+(non-default) ways.
+
+A few examples:
+
+To build an executable with profiling, with a dynamic by default GHC, and TH is used:
+ * Build dynamic (needed) objects
+ * Build profiled objects
+
+To build a library with profiling and dynamically, with a static by default GHC, and TH is used:
+ * Build dynamic (wanted) and static (needed) objects together with --dynamic-too
+ * Build profiled objects
+
+To build an executable statically, with a static by default GHC, regardless of whether TH is used:
+ * Simply build static objects
+
+-}
+
+-- | 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
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO (BuildWay -> GhcOptions)
+ -- ^ Returns a mapping from build ways to the 'GhcOptions' used in the
+ -- invocation used to compile the component in that 'BuildWay'.
+ -- This can be useful in, eg, a linker invocation, in which we want to use the
+ -- same options and list the same inputs as those used for building.
+buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays pbci = do
+ -- See Note [Building Haskell Modules accounting for TH]
+
+ let
+ verbosity = buildVerbosity pbci
+ isLib = buildIsLib pbci
+ clbi = buildCLBI pbci
+ lbi = localBuildInfo pbci
+ bi = buildBI pbci
+ what = buildingWhat pbci
+ comp = buildCompiler pbci
+
+ -- If this component will be loaded into a repl, we don't compile the modules at all.
+ forRepl
+ | 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?
+
+ -- Determine if program coverage should be enabled and if so, what
+ -- '-hpcdir' should be.
+ let isCoverageEnabled = if isLib then libCoverage lbi else exeCoverage lbi
+ hpcdir way
+ | forRepl = mempty -- HPC is not supported in ghci
+ | isCoverageEnabled = Flag $ Hpc.mixDir (buildTargetDir </> extraCompilationArtifacts) way
+ | otherwise = mempty
+
+ (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
+
+ let
+ runGhcProg = runGHC verbosity ghcProg comp platform
+ platform = hostPlatform lbi
+
+ -- See Note [Building Haskell Modules accounting for TH]
+ doingTH = usesTemplateHaskellOrQQ bi
+
+ -- We define the base opts which are shared across different build ways in
+ -- 'buildHaskellModules'
+ baseOpts way =
+ (Internal.componentGhcOptions verbosity lbi bi clbi buildTargetDir)
+ `mappend` mempty
+ { ghcOptMode = toFlag GhcModeMake
+ , -- Previously we didn't pass -no-link when building libs,
+ -- but I think that could result in a bug (e.g. if a lib module is
+ -- called Main and exports main). So we really want nolink when
+ -- building libs too (TODO).
+ ghcOptNoLink = if isLib then NoFlag else toFlag True
+ , ghcOptNumJobs = numJobs
+ , ghcOptInputModules = toNubListR inputModules
+ , ghcOptInputFiles =
+ toNubListR $
+ if PD.package pkg_descr == fakePackageId
+ then filter isHaskell inputFiles
+ else inputFiles
+ , ghcOptInputScripts =
+ toNubListR $
+ if PD.package pkg_descr == fakePackageId
+ then filter (not . isHaskell) inputFiles
+ else []
+ , ghcOptExtra = buildWayExtraHcOptions way GHC bi
+ , ghcOptHiSuffix = optSuffixFlag (buildWayPrefix way) "hi"
+ , ghcOptObjSuffix = optSuffixFlag (buildWayPrefix way) "o"
+ , ghcOptHPCDir = hpcdir (buildWayHpcWay way) -- maybe this should not be passed for vanilla?
+ }
+ where
+ optSuffixFlag "" _ = NoFlag
+ optSuffixFlag pre x = toFlag (pre ++ x)
+
+ -- For libs we don't pass -static when building static, leaving it
+ -- implicit. We should just always pass -static, but we don't want to
+ -- change behaviour when doing the refactor.
+ staticOpts = (baseOpts StaticWay){ghcOptDynLinkMode = if isLib then NoFlag else toFlag GhcStaticOnly}
+ dynOpts =
+ (baseOpts DynWay)
+ { ghcOptDynLinkMode = toFlag GhcDynamicOnly -- use -dynamic
+ , -- TODO: Does it hurt to set -fPIC for executables?
+ ghcOptFPic = toFlag True -- use -fPIC
+ }
+ profOpts =
+ (baseOpts ProfWay)
+ { ghcOptProfilingMode = toFlag True
+ , ghcOptProfilingAuto =
+ Internal.profDetailLevelFlag
+ (if isLib then True else False)
+ ((if isLib then withProfLibDetail else withProfExeDetail) lbi)
+ }
+ -- Options for building both static and dynamic way at the same time, using
+ -- the GHC flag -static and -dynamic-too
+ dynTooOpts =
+ (baseOpts StaticWay)
+ { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic -- use -dynamic-too
+ , ghcOptDynHiSuffix = toFlag (buildWayPrefix DynWay ++ "hi")
+ , ghcOptDynObjSuffix = toFlag (buildWayPrefix DynWay ++ "o")
+ , ghcOptHPCDir = hpcdir Hpc.Dyn
+ -- Should we pass hcSharedOpts in the -dynamic-too ghc invocation?
+ -- (Note that `baseOtps StaticWay = hcStaticOptions`, not hcSharedOpts)
+ }
+
+ -- Determines how to build for each way, also serves as the base options
+ -- for loading modules in 'linkOrLoadComponent'
+ buildOpts way = case way of
+ StaticWay -> staticOpts
+ DynWay -> dynOpts
+ ProfWay -> profOpts
+
+ 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.
+ unless (forRepl || (null inputFiles && null inputModules)) $ liftIO $ do
+ -- See Note [Building Haskell Modules accounting for TH]
+ let
+ neededWays =
+ wantedWays
+ <> Set.fromList
+ -- TODO: You also don't need to build the GHC way when doing TH 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 =
+ StaticWay `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]
+ ++ (runGhcProg . buildOpts <$> Set.toList neededWays \\ [StaticWay, DynWay])
+ -- Otherwise, we need to ensure the defaultGhcWay is built first
+ | otherwise =
+ runGhcProg . buildOpts <$> sortOn (\w -> if w == defaultGhcWay then 0 else fromEnum w + 1) (Set.toList neededWays)
+
+ 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 ()
+ in
+ -- REVIEW:ADD? info verbosity "Building Haskell Sources..."
+ sequence_ orderedBuilds
+ return buildOpts
+
+data BuildWay = StaticWay | DynWay | ProfWay
+ deriving (Eq, Ord, Show, Enum)
+
+-- | Returns the object/interface extension prefix for the given build way (e.g. "dyn_" for 'DynWay')
+buildWayPrefix :: BuildWay -> String
+buildWayPrefix = \case
+ StaticWay -> ""
+ ProfWay -> "p_"
+ DynWay -> "dyn_"
+
+-- | Returns the corresponding 'Hpc.Way' for a 'BuildWay'
+buildWayHpcWay :: BuildWay -> Hpc.Way
+buildWayHpcWay = \case
+ StaticWay -> Hpc.Vanilla
+ ProfWay -> Hpc.Prof
+ DynWay -> Hpc.Dyn
+
+-- | Returns a function to extract the extra haskell compiler options from a
+-- 'BuildInfo' and 'CompilerFlavor'
+buildWayExtraHcOptions :: BuildWay -> CompilerFlavor -> BuildInfo -> [String]
+buildWayExtraHcOptions = \case
+ StaticWay -> hcStaticOptions
+ ProfWay -> hcProfOptions
+ DynWay -> hcSharedOptions
+
+-- | Returns a pair of the Haskell input files and Haskell modules of the
+-- component being built.
+--
+-- The "input files" are either the path to the main Haskell module, or a repl
+-- script (that does not necessarily have an extension).
+componentInputs
+ :: FilePath
+ -- ^ Target build dir
+ -> PD.PackageDescription
+ -> PreBuildComponentInputs
+ -- ^ The context and component being built in it.
+ -> IO ([FilePath], [ModuleName])
+ -- ^ The Haskell input files, and the Haskell modules
+componentInputs buildTargetDir pkg_descr pbci = do
+ let
+ verbosity = buildVerbosity pbci
+ component = buildComponent pbci
+ clbi = buildCLBI pbci
+
+ 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
+ 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)
+ let mainModName = exeMainModuleName bnfo
+ 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)
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs b/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e5161e343da7c37199f7f36b974918d0f4a687a6
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Utils.hs
@@ -0,0 +1,217 @@
+module Distribution.Simple.GHC.Build.Utils where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Control.Monad (msum)
+import Data.Char (isLower)
+import Distribution.ModuleName (ModuleName)
+import qualified Distribution.ModuleName as ModuleName
+import Distribution.PackageDescription as PD
+import Distribution.PackageDescription.Utils (cabalBug)
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.Compiler
+import qualified Distribution.Simple.GHC.Internal as Internal
+import Distribution.Simple.Program.GHC
+import Distribution.Simple.Setup.Common
+import Distribution.Simple.Utils
+import Distribution.System
+import Distribution.Types.LocalBuildInfo
+import Distribution.Utils.Path (getSymbolicPath)
+import Distribution.Verbosity
+import System.FilePath
+ ( replaceExtension
+ , takeExtension
+ , (<.>)
+ , (</>)
+ )
+
+-- | Find the path to the entry point of an executable (typically specified in
+-- @main-is@, and found in @hs-source-dirs@).
+findExecutableMain
+ :: Verbosity
+ -> FilePath
+ -- ^ Build directory
+ -> (BuildInfo, FilePath)
+ -- ^ The build info and module path of an executable-like component (Exe, Test, Bench)
+ -> IO FilePath
+ -- ^ The path to the main source file.
+findExecutableMain verbosity bdir (bnfo, modPath) =
+ findFileEx verbosity (bdir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
+
+-- | Does this compiler support the @-dynamic-too@ option
+supportsDynamicToo :: Compiler -> Bool
+supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
+
+-- | Is this compiler's RTS dynamically linked?
+isDynamic :: Compiler -> Bool
+isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
+
+-- | Should we dynamically link the foreign library, based on its 'foreignLibType'?
+withDynFLib :: ForeignLib -> Bool
+withDynFLib flib =
+ case foreignLibType flib of
+ ForeignLibNativeShared ->
+ ForeignLibStandalone `notElem` foreignLibOptions flib
+ ForeignLibNativeStatic ->
+ False
+ ForeignLibTypeUnknown ->
+ cabalBug "unknown foreign lib type"
+
+-- | Is this file a C++ source file, i.e. ends with .cpp, .cxx, or .c++?
+isCxx :: FilePath -> Bool
+isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
+
+-- | Is this a C source file, i.e. ends with .c?
+isC :: FilePath -> Bool
+isC fp = elem (takeExtension fp) [".c"]
+
+-- | FilePath has a Haskell extension: .hs or .lhs
+isHaskell :: FilePath -> Bool
+isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
+
+-- | Returns True if the modification date of the given source file is newer than
+-- the object file we last compiled for it, or if no object file exists yet.
+checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
+checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
+ where
+ oname = getObjectFileName filename opts
+
+-- | Finds the object file name of the given source file
+getObjectFileName :: FilePath -> GhcOptions -> FilePath
+getObjectFileName filename opts = oname
+ where
+ odir = fromFlag (ghcOptObjDir opts)
+ oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
+ oname = odir </> replaceExtension filename oext
+
+-- | Target name for a foreign library (the actual file name)
+--
+-- We do not use mkLibName and co here because the naming for foreign libraries
+-- is slightly different (we don't use "_p" or compiler version suffices, and we
+-- don't want the "lib" prefix on Windows).
+--
+-- TODO: We do use `dllExtension` and co here, but really that's wrong: they
+-- use the OS used to build cabal to determine which extension to use, rather
+-- than the target OS (but this is wrong elsewhere in Cabal as well).
+flibTargetName :: LocalBuildInfo -> ForeignLib -> String
+flibTargetName lbi flib =
+ case (os, foreignLibType flib) of
+ (Windows, ForeignLibNativeShared) -> nm <.> "dll"
+ (Windows, ForeignLibNativeStatic) -> nm <.> "lib"
+ (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
+ (_other, ForeignLibNativeShared) ->
+ "lib" ++ nm <.> dllExtension (hostPlatform lbi)
+ (_other, ForeignLibNativeStatic) ->
+ "lib" ++ nm <.> staticLibExtension (hostPlatform lbi)
+ (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
+ where
+ nm :: String
+ nm = unUnqualComponentName $ foreignLibName flib
+
+ os :: OS
+ Platform _ os = hostPlatform lbi
+
+ -- If a foreign lib foo has lib-version-info 5:1:2 or
+ -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
+ -- Libtool's version-info data is translated into library versions in a
+ -- nontrivial way: so refer to libtool documentation.
+ versionedExt :: String
+ versionedExt =
+ let nums = foreignLibVersion flib os
+ in foldl (<.>) "so" (map show nums)
+
+-- | Name for the library when building.
+--
+-- If the `lib-version-info` field or the `lib-version-linux` field of
+-- a foreign library target is set, we need to incorporate that
+-- version into the SONAME field.
+--
+-- If a foreign library foo has lib-version-info 5:1:2, it should be
+-- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3.
+-- However, GHC does not allow overriding soname by setting linker
+-- options, as it sets a soname of its own (namely the output
+-- filename), after the user-supplied linker options. Hence, we have
+-- to compile the library with the soname as its filename. We rename
+-- the compiled binary afterwards.
+--
+-- This method allows to adjust the name of the library at build time
+-- such that the correct soname can be set.
+flibBuildName :: LocalBuildInfo -> ForeignLib -> String
+flibBuildName lbi flib
+ -- On linux, if a foreign-library has version data, the first digit is used
+ -- to produce the SONAME.
+ | (os, foreignLibType flib)
+ == (Linux, ForeignLibNativeShared) =
+ let nums = foreignLibVersion flib os
+ in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
+ | otherwise = flibTargetName lbi flib
+ where
+ os :: OS
+ Platform _ os = hostPlatform lbi
+
+ nm :: String
+ nm = unUnqualComponentName $ foreignLibName flib
+
+-- | Gets the target name (name of actual executable file) from the name of an
+-- executable-like component ('Executable', 'TestSuite', 'Benchmark').
+exeTargetName :: Platform -> UnqualComponentName -> String
+exeTargetName platform name = unUnqualComponentName name `withExt` exeExtension platform
+ where
+ withExt :: FilePath -> String -> FilePath
+ withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else ""
+
+-- | "Main" module name when overridden by @ghc-options: -main-is ...@
+-- or 'Nothing' if no @-main-is@ flag could be found.
+--
+-- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
+exeMainModuleName
+ :: BuildInfo
+ -- ^ The build info of the executable-like component (Exe, Test, Bench)
+ -> ModuleName
+exeMainModuleName bnfo =
+ -- GHC honors the last occurrence of a module name updated via -main-is
+ --
+ -- Moreover, -main-is when parsed left-to-right can update either
+ -- the "Main" module name, or the "main" function name, or both,
+ -- see also 'decodeMainIsArg'.
+ fromMaybe ModuleName.main $ msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
+ where
+ ghcopts = hcOptions GHC bnfo
+
+ findIsMainArgs [] = []
+ findIsMainArgs ("-main-is" : arg : rest) = arg : findIsMainArgs rest
+ findIsMainArgs (_ : rest) = findIsMainArgs rest
+
+-- | Decode argument to '-main-is'
+--
+-- Returns 'Nothing' if argument set only the function name.
+--
+-- This code has been stolen/refactored from GHC's DynFlags.setMainIs
+-- function. The logic here is deliberately imperfect as it is
+-- intended to be bug-compatible with GHC's parser. See discussion in
+-- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
+decodeMainIsArg :: String -> Maybe ModuleName
+decodeMainIsArg arg
+ | headOf main_fn isLower =
+ -- The arg looked like "Foo.Bar.baz"
+ Just (ModuleName.fromString main_mod)
+ | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar"
+ =
+ Just (ModuleName.fromString arg)
+ | otherwise -- The arg looked like "baz"
+ =
+ Nothing
+ where
+ headOf :: String -> (Char -> Bool) -> Bool
+ headOf str pred' = any pred' (safeHead str)
+
+ (main_mod, main_fn) = splitLongestPrefix arg (== '.')
+
+ splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
+ splitLongestPrefix str pred'
+ | null r_pre = (str, [])
+ | otherwise = (reverse (safeTail r_pre), reverse r_suf)
+ where
+ -- 'safeTail' drops the char satisfying 'pred'
+ (r_suf, r_pre) = break pred' (reverse str)
diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs
deleted file mode 100644
index 330cc656d04bca1401f264f21f14dbe0e80da66e..0000000000000000000000000000000000000000
--- a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs
+++ /dev/null
@@ -1,747 +0,0 @@
-module Distribution.Simple.GHC.BuildGeneric
- ( GBuildMode (..)
- , gbuild
- ) where
-
-import Distribution.Compat.Prelude
-import Prelude ()
-
-import Control.Monad (msum)
-import Data.Char (isLower)
-import Distribution.CabalSpecVersion
-import Distribution.InstalledPackageInfo (InstalledPackageInfo)
-import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
-import Distribution.ModuleName (ModuleName)
-import qualified Distribution.ModuleName as ModuleName
-import Distribution.Package
-import Distribution.PackageDescription as PD
-import Distribution.PackageDescription.Utils (cabalBug)
-import Distribution.Pretty
-import Distribution.Simple.BuildPaths
-import Distribution.Simple.Compiler
-import Distribution.Simple.GHC.Build
- ( checkNeedsRecompilation
- , componentGhcOptions
- , exeTargetName
- , flibBuildName
- , flibTargetName
- , getRPaths
- , isDynamic
- , replNoLoad
- , runReplOrWriteFlags
- , supportsDynamicToo
- )
-import Distribution.Simple.GHC.ImplInfo
-import qualified Distribution.Simple.GHC.Internal as Internal
-import qualified Distribution.Simple.Hpc as Hpc
-import Distribution.Simple.LocalBuildInfo
-import qualified Distribution.Simple.PackageIndex as PackageIndex
-import Distribution.Simple.Program
-import Distribution.Simple.Program.GHC
-import Distribution.Simple.Setup.Common
-import Distribution.Simple.Setup.Repl
-import Distribution.Simple.Utils
-import Distribution.System
-import Distribution.Types.PackageName.Magic
-import Distribution.Types.ParStrat
-import Distribution.Utils.NubList
-import Distribution.Utils.Path
-import Distribution.Verbosity
-import Distribution.Version
-import System.Directory
- ( doesDirectoryExist
- , doesFileExist
- , removeFile
- , renameFile
- )
-import System.FilePath
- ( replaceExtension
- , takeExtension
- , (</>)
- )
-
--- | A collection of:
--- * C input files
--- * C++ input files
--- * GHC input files
--- * GHC input modules
---
--- Used to correctly build and link sources.
-data BuildSources = BuildSources
- { cSourcesFiles :: [FilePath]
- , cxxSourceFiles :: [FilePath]
- , jsSourceFiles :: [FilePath]
- , asmSourceFiles :: [FilePath]
- , cmmSourceFiles :: [FilePath]
- , inputSourceFiles :: [FilePath]
- , inputSourceModules :: [ModuleName]
- }
-
-data DynamicRtsInfo = DynamicRtsInfo
- { dynRtsVanillaLib :: FilePath
- , dynRtsThreadedLib :: FilePath
- , dynRtsDebugLib :: FilePath
- , dynRtsEventlogLib :: FilePath
- , dynRtsThreadedDebugLib :: FilePath
- , dynRtsThreadedEventlogLib :: FilePath
- }
-
-data StaticRtsInfo = StaticRtsInfo
- { statRtsVanillaLib :: FilePath
- , statRtsThreadedLib :: FilePath
- , statRtsDebugLib :: FilePath
- , statRtsEventlogLib :: FilePath
- , statRtsThreadedDebugLib :: FilePath
- , statRtsThreadedEventlogLib :: FilePath
- , statRtsProfilingLib :: FilePath
- , statRtsThreadedProfilingLib :: FilePath
- }
-
-data RtsInfo = RtsInfo
- { rtsDynamicInfo :: DynamicRtsInfo
- , rtsStaticInfo :: StaticRtsInfo
- , rtsLibPaths :: [FilePath]
- }
-
--- | Building an executable, starting the REPL, and building foreign
--- libraries are all very similar and implemented in 'gbuild'. The
--- 'GBuildMode' distinguishes between the various kinds of operation.
-data GBuildMode
- = GBuildExe Executable
- | GReplExe ReplOptions Executable
- | GBuildFLib ForeignLib
- | GReplFLib ReplOptions ForeignLib
-
-gbuildInfo :: GBuildMode -> BuildInfo
-gbuildInfo (GBuildExe exe) = buildInfo exe
-gbuildInfo (GReplExe _ exe) = buildInfo exe
-gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib
-gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib
-
-gbuildIsRepl :: GBuildMode -> Bool
-gbuildIsRepl (GBuildExe _) = False
-gbuildIsRepl (GReplExe _ _) = True
-gbuildIsRepl (GBuildFLib _) = False
-gbuildIsRepl (GReplFLib _ _) = True
-
-gbuildModDefFiles :: GBuildMode -> [FilePath]
-gbuildModDefFiles (GBuildExe _) = []
-gbuildModDefFiles (GReplExe _ _) = []
-gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
-gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib
-
-gbuildName :: GBuildMode -> String
-gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe
-gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe
-gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib
-gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib
-
-gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
-gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe
-gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe
-gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib
-gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib
-
-gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
-gbuildNeedDynamic lbi bm =
- case bm of
- GBuildExe _ -> withDynExe lbi
- GReplExe _ _ -> withDynExe lbi
- GBuildFLib flib -> withDynFLib flib
- GReplFLib _ flib -> withDynFLib flib
- where
- withDynFLib flib =
- case foreignLibType flib of
- ForeignLibNativeShared ->
- ForeignLibStandalone `notElem` foreignLibOptions flib
- ForeignLibNativeStatic ->
- False
- ForeignLibTypeUnknown ->
- cabalBug "unknown foreign lib type"
-
--- | Locate and return the 'BuildSources' required to build and link.
-gbuildSources
- :: Verbosity
- -> PackageId
- -> CabalSpecVersion
- -> FilePath
- -> GBuildMode
- -> IO BuildSources
-gbuildSources verbosity pkgId specVer tmpDir bm =
- case bm of
- GBuildExe exe -> exeSources exe
- GReplExe _ exe -> exeSources exe
- GBuildFLib flib -> return $ flibSources flib
- GReplFLib _ flib -> return $ flibSources flib
- where
- exeSources :: Executable -> IO BuildSources
- exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
- main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
- let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
- otherModNames = exeModules exe
-
- -- Scripts have fakePackageId and are always Haskell but can have any extension.
- if isHaskell main || pkgId == fakePackageId
- then
- if specVer < 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
- BuildSources
- { cSourcesFiles = cSources bnfo
- , cxxSourceFiles = cxxSources bnfo
- , jsSourceFiles = jsSources bnfo
- , asmSourceFiles = asmSources bnfo
- , cmmSourceFiles = cmmSources bnfo
- , inputSourceFiles = [main]
- , inputSourceModules =
- filter (/= mainModName) $
- exeModules exe
- }
- else
- return
- BuildSources
- { cSourcesFiles = cSources bnfo
- , cxxSourceFiles = cxxSources bnfo
- , jsSourceFiles = jsSources bnfo
- , asmSourceFiles = asmSources bnfo
- , cmmSourceFiles = cmmSources bnfo
- , inputSourceFiles = [main]
- , inputSourceModules = exeModules exe
- }
- else
- let (csf, cxxsf)
- | isCxx main = (cSources bnfo, main : cxxSources bnfo)
- -- if main is not a Haskell source
- -- and main is not a C++ source
- -- then we assume that it is a C source
- | otherwise = (main : cSources bnfo, cxxSources bnfo)
- in return
- BuildSources
- { cSourcesFiles = csf
- , cxxSourceFiles = cxxsf
- , jsSourceFiles = jsSources bnfo
- , asmSourceFiles = asmSources bnfo
- , cmmSourceFiles = cmmSources bnfo
- , inputSourceFiles = []
- , inputSourceModules = exeModules exe
- }
-
- flibSources :: ForeignLib -> BuildSources
- flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} =
- BuildSources
- { cSourcesFiles = cSources bnfo
- , cxxSourceFiles = cxxSources bnfo
- , jsSourceFiles = jsSources bnfo
- , asmSourceFiles = asmSources bnfo
- , cmmSourceFiles = cmmSources bnfo
- , inputSourceFiles = []
- , inputSourceModules = foreignLibModules flib
- }
-
- isCxx :: FilePath -> Bool
- isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
-
--- | Extract (and compute) information about the RTS library
---
--- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
--- find this information somewhere. We can lookup the 'hsLibraries' field of
--- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
--- doesn't really help.
-extractRtsInfo :: LocalBuildInfo -> RtsInfo
-extractRtsInfo lbi =
- case PackageIndex.lookupPackageName
- (installedPkgs lbi)
- (mkPackageName "rts") of
- [(_, [rts])] -> aux rts
- _otherwise -> error "No (or multiple) ghc rts package is registered"
- where
- aux :: InstalledPackageInfo -> RtsInfo
- aux rts =
- RtsInfo
- { rtsDynamicInfo =
- DynamicRtsInfo
- { dynRtsVanillaLib = withGhcVersion "HSrts"
- , dynRtsThreadedLib = withGhcVersion "HSrts_thr"
- , dynRtsDebugLib = withGhcVersion "HSrts_debug"
- , dynRtsEventlogLib = withGhcVersion "HSrts_l"
- , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug"
- , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l"
- }
- , rtsStaticInfo =
- StaticRtsInfo
- { statRtsVanillaLib = "HSrts"
- , statRtsThreadedLib = "HSrts_thr"
- , statRtsDebugLib = "HSrts_debug"
- , statRtsEventlogLib = "HSrts_l"
- , statRtsThreadedDebugLib = "HSrts_thr_debug"
- , statRtsThreadedEventlogLib = "HSrts_thr_l"
- , statRtsProfilingLib = "HSrts_p"
- , statRtsThreadedProfilingLib = "HSrts_thr_p"
- }
- , rtsLibPaths = InstalledPackageInfo.libraryDirs rts
- }
- withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi))))
-
--- | Determine whether the given 'BuildInfo' is intended to link against the
--- threaded RTS. This is used to determine which RTS to link against when
--- building a foreign library with a GHC without support for @-flink-rts@.
-hasThreaded :: BuildInfo -> Bool
-hasThreaded bi = elem "-threaded" ghc
- where
- PerCompilerFlavor ghc _ = options bi
-
--- | FilePath has a Haskell extension: .hs or .lhs
-isHaskell :: FilePath -> Bool
-isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
-
--- | "Main" module name when overridden by @ghc-options: -main-is ...@
--- or 'Nothing' if no @-main-is@ flag could be found.
---
--- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
-exeMainModuleName :: Executable -> Maybe ModuleName
-exeMainModuleName Executable{buildInfo = bnfo} =
- -- GHC honors the last occurrence of a module name updated via -main-is
- --
- -- Moreover, -main-is when parsed left-to-right can update either
- -- the "Main" module name, or the "main" function name, or both,
- -- see also 'decodeMainIsArg'.
- msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
- where
- ghcopts = hcOptions GHC bnfo
-
- findIsMainArgs [] = []
- findIsMainArgs ("-main-is" : arg : rest) = arg : findIsMainArgs rest
- findIsMainArgs (_ : rest) = findIsMainArgs rest
-
--- | Decode argument to '-main-is'
---
--- Returns 'Nothing' if argument set only the function name.
---
--- This code has been stolen/refactored from GHC's DynFlags.setMainIs
--- function. The logic here is deliberately imperfect as it is
--- intended to be bug-compatible with GHC's parser. See discussion in
--- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
-decodeMainIsArg :: String -> Maybe ModuleName
-decodeMainIsArg arg
- | headOf main_fn isLower =
- -- The arg looked like "Foo.Bar.baz"
- Just (ModuleName.fromString main_mod)
- | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar"
- =
- Just (ModuleName.fromString arg)
- | otherwise -- The arg looked like "baz"
- =
- Nothing
- where
- headOf :: String -> (Char -> Bool) -> Bool
- headOf str pred' = any pred' (safeHead str)
-
- (main_mod, main_fn) = splitLongestPrefix arg (== '.')
-
- splitLongestPrefix :: String -> (Char -> Bool) -> (String, String)
- splitLongestPrefix str pred'
- | null r_pre = (str, [])
- | otherwise = (reverse (safeTail r_pre), reverse r_suf)
- where
- -- 'safeTail' drops the char satisfying 'pred'
- (r_suf, r_pre) = break pred' (reverse str)
-
--- | Generic build function. See comment for 'GBuildMode'.
-gbuild
- :: Verbosity
- -> Flag ParStrat
- -> PackageDescription
- -> LocalBuildInfo
- -> GBuildMode
- -> ComponentLocalBuildInfo
- -> IO ()
-gbuild verbosity numJobs pkg_descr lbi bm clbi = do
- (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- let replFlags = case bm of
- GReplExe flags _ -> flags
- GReplFLib flags _ -> flags
- GBuildExe{} -> mempty
- GBuildFLib{} -> mempty
- comp = compiler lbi
- platform = hostPlatform lbi
- implInfo = getImplInfo comp
- runGhcProg = runGHC verbosity ghcProg comp platform
-
- let bnfo = gbuildInfo bm
-
- -- the name that GHC really uses (e.g., with .exe on Windows for executables)
- let targetName = gbuildTargetName lbi bm
- let targetDir = buildDir lbi </> (gbuildName bm)
- let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
- createDirectoryIfMissingVerbose verbosity True targetDir
- createDirectoryIfMissingVerbose verbosity True tmpDir
-
- -- TODO: do we need to put hs-boot files into place for mutually recursive
- -- modules? FIX: what about exeName.hi-boot?
-
- -- Determine if program coverage should be enabled and if so, what
- -- '-hpcdir' should be.
- let isCoverageEnabled = exeCoverage lbi
- hpcdir way
- | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir (tmpDir </> extraCompilationArtifacts) way
- | otherwise = mempty
-
- rpaths <- getRPaths lbi clbi
- buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm
-
- -- ensure extra lib dirs exist before passing to ghc
- cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs bnfo)
- cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic bnfo)
-
- let cSrcs = cSourcesFiles buildSources
- cxxSrcs = cxxSourceFiles buildSources
- jsSrcs = jsSourceFiles buildSources
- asmSrcs = asmSourceFiles buildSources
- cmmSrcs = cmmSourceFiles buildSources
- inputFiles = inputSourceFiles buildSources
- inputModules = inputSourceModules buildSources
- isGhcDynamic = isDynamic comp
- dynamicTooSupported = supportsDynamicToo comp
- cLikeObjs = map (`replaceExtension` objExtension) cSrcs
- cxxObjs = map (`replaceExtension` objExtension) cxxSrcs
- jsObjs = if hasJsSupport then map (`replaceExtension` objExtension) jsSrcs else []
- asmObjs = map (`replaceExtension` objExtension) asmSrcs
- cmmObjs = map (`replaceExtension` objExtension) cmmSrcs
- needDynamic = gbuildNeedDynamic lbi bm
- needProfiling = withProfExe lbi
- Platform hostArch _ = hostPlatform lbi
- hasJsSupport = hostArch == JavaScript
-
- -- build executables
- baseOpts =
- (componentGhcOptions verbosity lbi bnfo clbi tmpDir)
- `mappend` mempty
- { ghcOptMode = toFlag GhcModeMake
- , ghcOptInputFiles =
- toNubListR $
- if package pkg_descr == fakePackageId
- then filter isHaskell inputFiles
- else inputFiles
- , ghcOptInputScripts =
- toNubListR $
- if package pkg_descr == fakePackageId
- then filter (not . isHaskell) inputFiles
- else []
- , ghcOptInputModules = toNubListR inputModules
- }
- staticOpts =
- baseOpts
- `mappend` mempty
- { ghcOptDynLinkMode = toFlag GhcStaticOnly
- , ghcOptHPCDir = hpcdir Hpc.Vanilla
- }
- profOpts =
- baseOpts
- `mappend` mempty
- { ghcOptProfilingMode = toFlag True
- , ghcOptProfilingAuto =
- Internal.profDetailLevelFlag
- False
- (withProfExeDetail lbi)
- , ghcOptHiSuffix = toFlag "p_hi"
- , ghcOptObjSuffix = toFlag "p_o"
- , ghcOptExtra = hcProfOptions GHC bnfo
- , ghcOptHPCDir = hpcdir Hpc.Prof
- }
- dynOpts =
- baseOpts
- `mappend` mempty
- { ghcOptDynLinkMode = toFlag GhcDynamicOnly
- , -- TODO: Does it hurt to set -fPIC for executables?
- ghcOptFPic = toFlag True
- , ghcOptHiSuffix = toFlag "dyn_hi"
- , ghcOptObjSuffix = toFlag "dyn_o"
- , ghcOptExtra = hcSharedOptions GHC bnfo
- , ghcOptHPCDir = hpcdir Hpc.Dyn
- }
- dynTooOpts =
- staticOpts
- `mappend` mempty
- { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
- , ghcOptDynHiSuffix = toFlag "dyn_hi"
- , ghcOptDynObjSuffix = toFlag "dyn_o"
- , ghcOptHPCDir = hpcdir Hpc.Dyn
- }
- linkerOpts =
- mempty
- { ghcOptLinkOptions =
- PD.ldOptions bnfo
- ++ [ "-static"
- | withFullyStaticExe lbi
- ]
- -- Pass extra `ld-options` given
- -- through to GHC's linker.
- ++ maybe
- []
- programOverrideArgs
- (lookupProgram ldProgram (withPrograms lbi))
- , ghcOptLinkLibs =
- if withFullyStaticExe lbi
- then extraLibsStatic bnfo
- else extraLibs bnfo
- , ghcOptLinkLibPath =
- toNubListR $
- if withFullyStaticExe lbi
- then cleanedExtraLibDirsStatic
- else cleanedExtraLibDirs
- , ghcOptLinkFrameworks =
- toNubListR $
- PD.frameworks bnfo
- , ghcOptLinkFrameworkDirs =
- toNubListR $
- PD.extraFrameworkDirs bnfo
- , ghcOptInputFiles =
- toNubListR
- [tmpDir </> x | x <- cLikeObjs ++ cxxObjs ++ jsObjs ++ cmmObjs ++ asmObjs]
- }
- dynLinkerOpts =
- mempty
- { ghcOptRPaths = rpaths <> toNubListR (extraLibDirs bnfo)
- , ghcOptInputFiles =
- toNubListR
- [tmpDir </> x | x <- cLikeObjs ++ cxxObjs ++ cmmObjs ++ asmObjs]
- }
- replOpts =
- baseOpts
- { ghcOptExtra =
- Internal.filterGhciFlags
- (ghcOptExtra baseOpts)
- <> replOptionsFlags replFlags
- , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules baseOpts)
- , ghcOptInputFiles = replNoLoad replFlags (ghcOptInputFiles baseOpts)
- }
- -- For a normal compile we do separate invocations of ghc for
- -- compiling as for linking. But for repl we have to do just
- -- the one invocation, so that one has to include all the
- -- linker stuff too, like -l flags and any .o files from C
- -- files etc.
- `mappend` linkerOpts
- `mappend` mempty
- { ghcOptMode = toFlag GhcModeInteractive
- , ghcOptOptimisation = toFlag GhcNoOptimisation
- }
- commonOpts
- | needProfiling = profOpts
- | needDynamic = dynOpts
- | otherwise = staticOpts
- compileOpts
- | useDynToo = dynTooOpts
- | otherwise = commonOpts
- withStaticExe = not needProfiling && not needDynamic
-
- -- For building exe's that use TH with -prof or -dynamic we actually have
- -- to build twice, once without -prof/-dynamic and then again with
- -- -prof/-dynamic. This is because the code that TH needs to run at
- -- compile time needs to be the vanilla ABI so it can be loaded up and run
- -- by the compiler.
- -- With dynamic-by-default GHC the TH object files loaded at compile-time
- -- need to be .dyn_o instead of .o.
- doingTH = usesTemplateHaskellOrQQ bnfo
- -- Should we use -dynamic-too instead of compiling twice?
- useDynToo =
- dynamicTooSupported
- && isGhcDynamic
- && doingTH
- && withStaticExe
- && null (hcSharedOptions GHC bnfo)
- compileTHOpts
- | isGhcDynamic = dynOpts
- | otherwise = staticOpts
- compileForTH
- | gbuildIsRepl bm = False
- | useDynToo = False
- | isGhcDynamic = doingTH && (needProfiling || withStaticExe)
- | otherwise = doingTH && (needProfiling || needDynamic)
-
- -- Build static/dynamic object files for TH, if needed.
- when compileForTH $
- runGhcProg
- compileTHOpts
- { ghcOptNoLink = toFlag True
- , ghcOptNumJobs = numJobs
- }
-
- -- Do not try to build anything if there are no input files.
- -- This can happen if the cabal file ends up with only cSrcs
- -- but no Haskell modules.
- unless
- ( (null inputFiles && null inputModules)
- || gbuildIsRepl bm
- )
- $ runGhcProg
- compileOpts
- { ghcOptNoLink = toFlag True
- , ghcOptNumJobs = numJobs
- }
-
- let
- buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn
- buildExtraSource mkSrcOpts wantDyn filename = do
- let baseSrcOpts =
- mkSrcOpts
- verbosity
- implInfo
- lbi
- bnfo
- clbi
- tmpDir
- filename
- vanillaSrcOpts =
- if isGhcDynamic && wantDyn
- then -- Dynamic GHC requires C/C++ sources to be built
- -- with -fPIC for REPL to work. See #2207.
- baseSrcOpts{ghcOptFPic = toFlag True}
- else baseSrcOpts
- profSrcOpts =
- vanillaSrcOpts
- `mappend` mempty
- { ghcOptProfilingMode = toFlag True
- }
- sharedSrcOpts =
- vanillaSrcOpts
- `mappend` mempty
- { ghcOptFPic = toFlag True
- , ghcOptDynLinkMode = toFlag GhcDynamicOnly
- }
- opts
- | needProfiling = profSrcOpts
- | needDynamic && wantDyn = sharedSrcOpts
- | otherwise = vanillaSrcOpts
- -- TODO: Placing all Haskell, C, & C++ objects in a single directory
- -- Has the potential for file collisions. In general we would
- -- consider this a user error. However, we should strive to
- -- add a warning if this occurs.
- odir = fromFlag (ghcOptObjDir opts)
-
- createDirectoryIfMissingVerbose verbosity True odir
- needsRecomp <- checkNeedsRecompilation filename opts
- when needsRecomp $
- runGhcProg opts
-
- -- build any C++ sources
- unless (null cxxSrcs) $ do
- info verbosity "Building C++ Sources..."
- buildExtraSources Internal.componentCxxGhcOptions True cxxSrcs
-
- -- build any C sources
- unless (null cSrcs) $ do
- info verbosity "Building C Sources..."
- buildExtraSources Internal.componentCcGhcOptions True cSrcs
-
- -- build any JS sources
- unless (not hasJsSupport || null jsSrcs) $ do
- info verbosity "Building JS Sources..."
- buildExtraSources Internal.componentJsGhcOptions False jsSrcs
-
- -- build any ASM sources
- unless (null asmSrcs) $ do
- info verbosity "Building Assembler Sources..."
- buildExtraSources Internal.componentAsmGhcOptions True asmSrcs
-
- -- build any Cmm sources
- unless (null cmmSrcs) $ do
- info verbosity "Building C-- Sources..."
- buildExtraSources Internal.componentCmmGhcOptions True cmmSrcs
-
- -- TODO: problem here is we need the .c files built first, so we can load them
- -- with ghci, but .c files can depend on .h files generated by ghc by ffi
- -- exports.
- case bm of
- GReplExe _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr))
- GReplFLib _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr))
- GBuildExe _ -> do
- let linkOpts =
- commonOpts
- `mappend` linkerOpts
- `mappend` mempty
- { ghcOptLinkNoHsMain = toFlag (null inputFiles)
- }
- `mappend` (if withDynExe lbi then dynLinkerOpts else mempty)
-
- info verbosity "Linking..."
- -- Work around old GHCs not relinking in this
- -- situation, see #3294
- let target = targetDir </> targetName
- when (compilerVersion comp < mkVersion [7, 7]) $ do
- e <- doesFileExist target
- when e (removeFile target)
- runGhcProg linkOpts{ghcOptOutputFile = toFlag target}
- GBuildFLib flib -> do
- let
- -- Instruct GHC to link against libHSrts.
- rtsLinkOpts :: GhcOptions
- rtsLinkOpts
- | supportsFLinkRts =
- mempty
- { ghcOptLinkRts = toFlag True
- }
- | otherwise =
- mempty
- { ghcOptLinkLibs = rtsOptLinkLibs
- , ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
- }
- where
- threaded = hasThreaded (gbuildInfo bm)
- supportsFLinkRts = compilerVersion comp >= mkVersion [9, 0]
- rtsInfo = extractRtsInfo lbi
- rtsOptLinkLibs =
- [ if needDynamic
- then
- if threaded
- then dynRtsThreadedLib (rtsDynamicInfo rtsInfo)
- else dynRtsVanillaLib (rtsDynamicInfo rtsInfo)
- else
- if threaded
- then statRtsThreadedLib (rtsStaticInfo rtsInfo)
- else statRtsVanillaLib (rtsStaticInfo rtsInfo)
- ]
-
- linkOpts :: GhcOptions
- linkOpts = case foreignLibType flib of
- ForeignLibNativeShared ->
- commonOpts
- `mappend` linkerOpts
- `mappend` dynLinkerOpts
- `mappend` rtsLinkOpts
- `mappend` mempty
- { ghcOptLinkNoHsMain = toFlag True
- , ghcOptShared = toFlag True
- , ghcOptFPic = toFlag True
- , ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
- }
- ForeignLibNativeStatic ->
- -- this should be caught by buildFLib
- -- (and if we do implement this, we probably don't even want to call
- -- ghc here, but rather Ar.createArLibArchive or something)
- cabalBug "static libraries not yet implemented"
- ForeignLibTypeUnknown ->
- cabalBug "unknown foreign lib type"
- -- We build under a (potentially) different filename to set a
- -- soname on supported platforms. See also the note for
- -- @flibBuildName@.
- info verbosity "Linking..."
- let buildName = flibBuildName lbi flib
- runGhcProg linkOpts{ghcOptOutputFile = toFlag (targetDir </> buildName)}
- renameFile (targetDir </> buildName) (targetDir </> targetName)
diff --git a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs
deleted file mode 100644
index 64a8f0a6c40ace92e9e48c43390aa1212195a27d..0000000000000000000000000000000000000000
--- a/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs
+++ /dev/null
@@ -1,541 +0,0 @@
-module Distribution.Simple.GHC.BuildOrRepl (buildOrReplLib) where
-
-import Distribution.Compat.Prelude
-import Prelude ()
-
-import Control.Monad (forM_)
-import qualified Distribution.ModuleName as ModuleName
-import Distribution.Package
-import Distribution.PackageDescription as PD
-import Distribution.Simple.BuildPaths
-import Distribution.Simple.Compiler
-import Distribution.Simple.GHC.Build
- ( checkNeedsRecompilation
- , componentGhcOptions
- , getRPaths
- , isDynamic
- , replNoLoad
- , runReplOrWriteFlags
- , supportsDynamicToo
- )
-import Distribution.Simple.GHC.ImplInfo
-import qualified Distribution.Simple.GHC.Internal as Internal
-import qualified Distribution.Simple.Hpc as Hpc
-import Distribution.Simple.LocalBuildInfo
-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.Types.ParStrat
-import Distribution.Utils.NubList
-import Distribution.Verbosity
-import Distribution.Version
-import System.Directory
- ( doesDirectoryExist
- , makeRelativeToCurrentDirectory
- )
-import System.FilePath
- ( replaceExtension
- , (</>)
- )
-
-buildOrReplLib
- :: Maybe ReplOptions
- -> Verbosity
- -> Flag ParStrat
- -> PackageDescription
- -> LocalBuildInfo
- -> Library
- -> ComponentLocalBuildInfo
- -> IO ()
-buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
- let uid = componentUnitId clbi
- libTargetDir = componentBuildDir lbi clbi
- whenVanillaLib forceVanilla =
- when (forceVanilla || withVanillaLib lbi)
- whenProfLib = when (withProfLib lbi)
- whenSharedLib forceShared =
- when (forceShared || withSharedLib lbi)
- whenStaticLib forceStatic =
- when (forceStatic || withStaticLib lbi)
- whenGHCiLib = when (withGHCiLib lbi)
- forRepl = maybe False (const True) mReplFlags
- whenReplLib = forM_ mReplFlags
- replFlags = fromMaybe mempty mReplFlags
- comp = compiler lbi
- ghcVersion = compilerVersion comp
- implInfo = getImplInfo comp
- platform@(Platform hostArch hostOS) = hostPlatform lbi
- hasJsSupport = hostArch == JavaScript
- has_code = not (componentIsIndefinite clbi)
-
- relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir
-
- (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- let runGhcProg = runGHC verbosity ghcProg comp platform
-
- let libBi = libBuildInfo lib
-
- -- ensure extra lib dirs exist before passing to ghc
- cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi)
- cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi)
-
- let isGhcDynamic = isDynamic comp
- dynamicTooSupported = supportsDynamicToo comp
- doingTH = usesTemplateHaskellOrQQ libBi
- forceVanillaLib = doingTH && not isGhcDynamic
- forceSharedLib = doingTH && isGhcDynamic
- -- TH always needs default libs, even when building for profiling
-
- -- Determine if program coverage should be enabled and if so, what
- -- '-hpcdir' should be.
- let isCoverageEnabled = libCoverage lbi
- hpcdir way
- | forRepl = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir (libTargetDir </> extraCompilationArtifacts) way
- | otherwise = mempty
-
- createDirectoryIfMissingVerbose verbosity True libTargetDir
- -- TODO: do we need to put hs-boot files into place for mutually recursive
- -- modules?
- let cLikeSources =
- fromNubListR $
- mconcat
- [ toNubListR (cSources libBi)
- , toNubListR (cxxSources libBi)
- , toNubListR (cmmSources libBi)
- , toNubListR (asmSources libBi)
- , 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.
- toNubListR (jsSources libBi)
- else mempty
- ]
- cLikeObjs = map (`replaceExtension` objExtension) cLikeSources
- baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
- vanillaOpts =
- baseOpts
- `mappend` mempty
- { ghcOptMode = toFlag GhcModeMake
- , ghcOptNumJobs = numJobs
- , ghcOptInputModules = toNubListR $ allLibModules lib clbi
- , ghcOptHPCDir = hpcdir Hpc.Vanilla
- }
-
- profOpts =
- vanillaOpts
- `mappend` mempty
- { ghcOptProfilingMode = toFlag True
- , ghcOptProfilingAuto =
- Internal.profDetailLevelFlag
- True
- (withProfLibDetail lbi)
- , ghcOptHiSuffix = toFlag "p_hi"
- , ghcOptObjSuffix = toFlag "p_o"
- , ghcOptExtra = hcProfOptions GHC libBi
- , ghcOptHPCDir = hpcdir Hpc.Prof
- }
-
- sharedOpts =
- vanillaOpts
- `mappend` mempty
- { ghcOptDynLinkMode = toFlag GhcDynamicOnly
- , ghcOptFPic = toFlag True
- , ghcOptHiSuffix = toFlag "dyn_hi"
- , ghcOptObjSuffix = toFlag "dyn_o"
- , ghcOptExtra = hcSharedOptions GHC libBi
- , ghcOptHPCDir = hpcdir Hpc.Dyn
- }
- linkerOpts =
- mempty
- { ghcOptLinkOptions =
- PD.ldOptions libBi
- ++ [ "-static"
- | withFullyStaticExe lbi
- ]
- -- Pass extra `ld-options` given
- -- through to GHC's linker.
- ++ maybe
- []
- programOverrideArgs
- (lookupProgram ldProgram (withPrograms lbi))
- , ghcOptLinkLibs =
- if withFullyStaticExe lbi
- then extraLibsStatic libBi
- else extraLibs libBi
- , ghcOptLinkLibPath =
- toNubListR $
- if withFullyStaticExe lbi
- then cleanedExtraLibDirsStatic
- else cleanedExtraLibDirs
- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
- , ghcOptLinkFrameworkDirs =
- toNubListR $
- PD.extraFrameworkDirs libBi
- , ghcOptInputFiles =
- toNubListR
- [relLibTargetDir </> x | x <- cLikeObjs]
- }
- replOpts =
- vanillaOpts
- { ghcOptExtra =
- Internal.filterGhciFlags
- (ghcOptExtra vanillaOpts)
- <> replOptionsFlags replFlags
- , ghcOptNumJobs = mempty
- , ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts)
- }
- `mappend` linkerOpts
- `mappend` mempty
- { ghcOptMode = isInteractive
- , ghcOptOptimisation = toFlag GhcNoOptimisation
- }
-
- isInteractive = toFlag GhcModeInteractive
-
- vanillaSharedOpts =
- vanillaOpts
- `mappend` mempty
- { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic
- , ghcOptDynHiSuffix = toFlag "dyn_hi"
- , ghcOptDynObjSuffix = toFlag "dyn_o"
- , ghcOptHPCDir = hpcdir Hpc.Dyn
- }
-
- unless (forRepl || null (allLibModules lib clbi)) $
- do
- let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
- shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts)
- useDynToo =
- dynamicTooSupported
- && (forceVanillaLib || withVanillaLib lbi)
- && (forceSharedLib || withSharedLib lbi)
- && null (hcSharedOptions GHC libBi)
- if not has_code
- then vanilla
- else
- if useDynToo
- then do
- runGhcProg vanillaSharedOpts
- 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 ()
- else
- if isGhcDynamic
- then do shared; vanilla
- else do vanilla; shared
- whenProfLib (runGhcProg profOpts)
-
- let
- buildExtraSources mkSrcOpts wantDyn = traverse_ $ buildExtraSource mkSrcOpts wantDyn
- buildExtraSource mkSrcOpts wantDyn filename = do
- let baseSrcOpts =
- mkSrcOpts
- verbosity
- implInfo
- lbi
- libBi
- clbi
- relLibTargetDir
- filename
- vanillaSrcOpts
- -- Dynamic GHC requires C sources to be built
- -- with -fPIC for REPL to work. See #2207.
- | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True}
- | otherwise = baseSrcOpts
- runGhcProgIfNeeded opts = do
- needsRecomp <- checkNeedsRecompilation filename opts
- when needsRecomp $ runGhcProg opts
- profSrcOpts =
- vanillaSrcOpts
- `mappend` mempty
- { ghcOptProfilingMode = toFlag True
- , ghcOptObjSuffix = toFlag "p_o"
- }
- sharedSrcOpts =
- vanillaSrcOpts
- `mappend` mempty
- { ghcOptFPic = toFlag True
- , ghcOptDynLinkMode = toFlag GhcDynamicOnly
- , ghcOptObjSuffix = toFlag "dyn_o"
- }
- odir = fromFlag (ghcOptObjDir vanillaSrcOpts)
-
- createDirectoryIfMissingVerbose verbosity True odir
- runGhcProgIfNeeded vanillaSrcOpts
- unless (forRepl || not wantDyn) $
- whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedSrcOpts)
- unless forRepl $
- whenProfLib (runGhcProgIfNeeded profSrcOpts)
-
- -- Build any C++ sources separately.
- unless (not has_code || null (cxxSources libBi)) $ do
- info verbosity "Building C++ Sources..."
- buildExtraSources Internal.componentCxxGhcOptions True (cxxSources libBi)
-
- -- build any C sources
- unless (not has_code || null (cSources libBi)) $ do
- info verbosity "Building C Sources..."
- buildExtraSources Internal.componentCcGhcOptions True (cSources libBi)
-
- -- build any JS sources
- unless (not has_code || not hasJsSupport || null (jsSources libBi)) $ do
- info verbosity "Building JS Sources..."
- buildExtraSources Internal.componentJsGhcOptions False (jsSources libBi)
-
- -- build any ASM sources
- unless (not has_code || null (asmSources libBi)) $ do
- info verbosity "Building Assembler Sources..."
- buildExtraSources Internal.componentAsmGhcOptions True (asmSources libBi)
-
- -- build any Cmm sources
- unless (not has_code || null (cmmSources libBi)) $ do
- info verbosity "Building C-- Sources..."
- buildExtraSources Internal.componentCmmGhcOptions True (cmmSources libBi)
-
- -- TODO: problem here is we need the .c files built first, so we can load them
- -- with ghci, but .c files can depend on .h files generated by ghc by ffi
- -- exports.
- whenReplLib $ \rflags -> do
- when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
- runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts libBi clbi (pkgName (PD.package pkg_descr))
-
- -- link:
- when has_code . unless forRepl $ do
- info verbosity "Linking..."
- let cLikeProfObjs =
- map
- (`replaceExtension` ("p_" ++ objExtension))
- cLikeSources
- cLikeSharedObjs =
- map
- (`replaceExtension` ("dyn_" ++ objExtension))
- cLikeSources
- compiler_id = compilerId (compiler lbi)
- vanillaLibFilePath = relLibTargetDir </> mkLibName uid
- profileLibFilePath = relLibTargetDir </> mkProfLibName uid
- sharedLibFilePath =
- relLibTargetDir
- </> mkSharedLibName (hostPlatform lbi) compiler_id uid
- staticLibFilePath =
- relLibTargetDir
- </> mkStaticLibName (hostPlatform lbi) compiler_id uid
- ghciLibFilePath = relLibTargetDir </> Internal.mkGHCiLibName uid
- ghciProfLibFilePath = relLibTargetDir </> Internal.mkGHCiProfLibName uid
- libInstallPath =
- libdir $
- absoluteComponentInstallDirs
- pkg_descr
- lbi
- uid
- NoCopyDest
- sharedLibInstallPath =
- libInstallPath
- </> mkSharedLibName (hostPlatform lbi) compiler_id uid
-
- stubObjs <-
- catMaybes
- <$> sequenceA
- [ findFileWithExtension
- [objExtension]
- [libTargetDir]
- (ModuleName.toFilePath x ++ "_stub")
- | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
- , x <- allLibModules lib clbi
- ]
- stubProfObjs <-
- catMaybes
- <$> sequenceA
- [ findFileWithExtension
- ["p_" ++ objExtension]
- [libTargetDir]
- (ModuleName.toFilePath x ++ "_stub")
- | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
- , x <- allLibModules lib clbi
- ]
- stubSharedObjs <-
- catMaybes
- <$> sequenceA
- [ findFileWithExtension
- ["dyn_" ++ objExtension]
- [libTargetDir]
- (ModuleName.toFilePath x ++ "_stub")
- | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
- , x <- allLibModules lib clbi
- ]
-
- hObjs <-
- Internal.getHaskellObjects
- implInfo
- lib
- lbi
- clbi
- relLibTargetDir
- objExtension
- True
- hProfObjs <-
- if withProfLib lbi
- then
- Internal.getHaskellObjects
- implInfo
- lib
- lbi
- clbi
- relLibTargetDir
- ("p_" ++ objExtension)
- True
- else return []
- hSharedObjs <-
- if withSharedLib lbi
- then
- Internal.getHaskellObjects
- implInfo
- lib
- lbi
- clbi
- relLibTargetDir
- ("dyn_" ++ objExtension)
- False
- else return []
-
- unless (null hObjs && null cLikeObjs && null stubObjs) $ do
- rpaths <- getRPaths lbi clbi
-
- let staticObjectFiles =
- hObjs
- ++ map (relLibTargetDir </>) cLikeObjs
- ++ stubObjs
- profObjectFiles =
- hProfObjs
- ++ map (relLibTargetDir </>) cLikeProfObjs
- ++ stubProfObjs
- dynamicObjectFiles =
- hSharedObjs
- ++ map (relLibTargetDir </>) cLikeSharedObjs
- ++ stubSharedObjs
- -- After the relocation lib is created we invoke ghc -shared
- -- with the dependencies spelled out as -package arguments
- -- and ghc invokes the linker with the proper library paths
- ghcSharedLinkArgs =
- mempty
- { ghcOptShared = toFlag True
- , ghcOptDynLinkMode = toFlag GhcDynamicOnly
- , ghcOptInputFiles = toNubListR dynamicObjectFiles
- , ghcOptOutputFile = toFlag sharedLibFilePath
- , ghcOptExtra = hcSharedOptions GHC libBi
- , -- For dynamic libs, Mac OS/X needs to know the install location
- -- at build time. This only applies to GHC < 7.8 - see the
- -- discussion in #1660.
- ghcOptDylibName =
- if hostOS == OSX
- && ghcVersion < mkVersion [7, 8]
- then toFlag sharedLibInstallPath
- else mempty
- , ghcOptHideAllPackages = toFlag True
- , ghcOptNoAutoLinkPackages = toFlag True
- , ghcOptPackageDBs = withPackageDB lbi
- , ghcOptThisUnitId = case clbi of
- LibComponentLocalBuildInfo{componentCompatPackageKey = pk} ->
- toFlag pk
- _ -> mempty
- , ghcOptThisComponentId = case clbi of
- LibComponentLocalBuildInfo
- { componentInstantiatedWith = insts
- } ->
- if null insts
- then mempty
- else toFlag (componentComponentId clbi)
- _ -> mempty
- , ghcOptInstantiatedWith = case clbi of
- LibComponentLocalBuildInfo
- { componentInstantiatedWith = insts
- } ->
- insts
- _ -> []
- , ghcOptPackages =
- toNubListR $
- Internal.mkGhcOptPackages mempty clbi
- , ghcOptLinkLibs = extraLibs libBi
- , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
- , ghcOptLinkFrameworkDirs =
- toNubListR $ PD.extraFrameworkDirs libBi
- , ghcOptRPaths = rpaths <> toNubListR (extraLibDirs libBi)
- }
- ghcStaticLinkArgs =
- mempty
- { ghcOptStaticLib = toFlag True
- , ghcOptInputFiles = toNubListR staticObjectFiles
- , ghcOptOutputFile = toFlag staticLibFilePath
- , ghcOptExtra = hcStaticOptions GHC libBi
- , ghcOptHideAllPackages = toFlag True
- , ghcOptNoAutoLinkPackages = toFlag True
- , ghcOptPackageDBs = withPackageDB lbi
- , ghcOptThisUnitId = case clbi of
- LibComponentLocalBuildInfo{componentCompatPackageKey = pk} ->
- toFlag pk
- _ -> mempty
- , ghcOptThisComponentId = case clbi of
- LibComponentLocalBuildInfo
- { componentInstantiatedWith = insts
- } ->
- if null insts
- then mempty
- else toFlag (componentComponentId clbi)
- _ -> mempty
- , ghcOptInstantiatedWith = case clbi of
- LibComponentLocalBuildInfo
- { componentInstantiatedWith = insts
- } ->
- insts
- _ -> []
- , ghcOptPackages =
- toNubListR $
- Internal.mkGhcOptPackages mempty clbi
- , ghcOptLinkLibs = extraLibs libBi
- , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
- }
-
- info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
-
- whenVanillaLib False $ do
- Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
- whenGHCiLib $ do
- (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
- Ld.combineObjectFiles
- verbosity
- lbi
- ldProg
- ghciLibFilePath
- staticObjectFiles
-
- whenProfLib $ do
- Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
- whenGHCiLib $ do
- (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
- Ld.combineObjectFiles
- verbosity
- lbi
- ldProg
- ghciProfLibFilePath
- profObjectFiles
-
- whenSharedLib False $
- runGhcProg ghcSharedLinkArgs
-
- whenStaticLib False $
- runGhcProg ghcStaticLinkArgs
diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
index 322a227adfd430843cab761a71482ff047e0cf57..3ab3c85be355f9fc946a617c1b00d2f2f8b8d5e0 100644
--- a/Cabal/src/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -333,14 +333,13 @@ getExtensions verbosity implInfo ghcProg = do
componentCcGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
-componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
+componentCcGhcOptions verbosity lbi bi clbi odir filename =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
@@ -383,14 +382,13 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
componentCxxGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
-componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename =
+componentCxxGhcOptions verbosity lbi bi clbi odir filename =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
@@ -433,14 +431,13 @@ componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename =
componentAsmGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
-componentAsmGhcOptions verbosity _implInfo lbi bi clbi odir filename =
+componentAsmGhcOptions verbosity lbi bi clbi odir filename =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
@@ -478,14 +475,13 @@ componentAsmGhcOptions verbosity _implInfo lbi bi clbi odir filename =
componentJsGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
-componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename =
+componentJsGhcOptions verbosity lbi bi clbi odir filename =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
@@ -511,87 +507,87 @@ componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename =
componentGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> GhcOptions
-componentGhcOptions verbosity implInfo lbi bi clbi odir =
- 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)
- }
+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)
+ }
where
exe_paths =
[ componentBuildDir lbi (targetCLBI exe_tgt)
@@ -607,14 +603,13 @@ toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
componentCmmGhcOptions
:: Verbosity
- -> GhcImplInfo
-> LocalBuildInfo
-> BuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> FilePath
-> GhcOptions
-componentCmmGhcOptions verbosity _implInfo lbi bi clbi odir filename =
+componentCmmGhcOptions verbosity lbi bi clbi odir filename =
mempty
{ -- Respect -v0, but don't crank up verbosity on GHC if
-- Cabal verbosity is requested. For that, use --ghc-option=-v instead!
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
index 12860ca104ffa4dc02b095c3c91a92229a2a378a..98daaabf9813cfdd6b17e57e65e9a0c3f709bf43 100644
--- a/Cabal/src/Distribution/Simple/GHCJS.hs
+++ b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -23,7 +23,7 @@ module Distribution.Simple.GHCJS
, hcPkgInfo
, registerPackage
, componentGhcOptions
- , componentCcGhcOptions
+ , Internal.componentCcGhcOptions
, getLibDir
, isDynamic
, getGlobalPackageDB
@@ -1214,7 +1214,6 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
GBuildFLib{} -> mempty
comp = compiler lbi
platform = hostPlatform lbi
- implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcjsProg comp platform
let (bnfo, threaded) = case bm of
@@ -1418,7 +1417,6 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
let baseCxxOpts =
Internal.componentCxxGhcOptions
verbosity
- implInfo
lbi
bnfo
clbi
@@ -1465,7 +1463,6 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
let baseCcOpts =
Internal.componentCcGhcOptions
verbosity
- implInfo
lbi
bnfo
clbi
@@ -1780,27 +1777,11 @@ componentGhcOptions
-> FilePath
-> GhcOptions
componentGhcOptions verbosity lbi bi clbi odir =
- let opts = Internal.componentGhcOptions verbosity implInfo lbi bi clbi odir
- comp = compiler lbi
- implInfo = getImplInfo comp
+ let opts = Internal.componentGhcOptions verbosity lbi bi clbi odir
in opts
{ ghcOptExtra = ghcOptExtra opts `mappend` hcOptions GHCJS bi
}
-componentCcGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> FilePath
- -> FilePath
- -> GhcOptions
-componentCcGhcOptions verbosity lbi =
- Internal.componentCcGhcOptions verbosity implInfo lbi
- where
- comp = compiler lbi
- implInfo = getImplInfo comp
-
-- -----------------------------------------------------------------------------
-- Installing
diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs
index b4d55d604bafa86c5daea4fa801f97e285562971..cd8f10aff3c41692aa39cee0f28f35b9b4f92995 100644
--- a/Cabal/src/Distribution/Simple/Setup.hs
+++ b/Cabal/src/Distribution/Simple/Setup.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
@@ -131,9 +132,13 @@ module Distribution.Simple.Setup
, trueArg
, falseArg
, optionVerbosity
+ , BuildingWhat (..)
+ , buildingWhatVerbosity
+ , buildingWhatDistPref
) where
-import Prelude ()
+import GHC.Generics (Generic)
+import Prelude (FilePath, Show, ($))
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs
@@ -154,6 +159,37 @@ import Distribution.Simple.Setup.Repl
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Setup.Test
+import Distribution.Verbosity (Verbosity)
+
+-- | What kind of build are we doing?
+--
+-- Is this a normal build, or is it perhaps for running an interactive
+-- session or Haddock?
+data BuildingWhat
+ = -- | A normal build.
+ BuildNormal BuildFlags
+ | -- | Build steps for an interactive session.
+ BuildRepl ReplFlags
+ | -- | Build steps for generating documentation.
+ BuildHaddock HaddockFlags
+ | -- | Build steps for Hscolour.
+ BuildHscolour HscolourFlags
+ deriving (Generic, Show)
+
+buildingWhatVerbosity :: BuildingWhat -> Verbosity
+buildingWhatVerbosity = \case
+ BuildNormal flags -> fromFlag $ buildVerbosity flags
+ BuildRepl flags -> fromFlag $ replVerbosity flags
+ BuildHaddock flags -> fromFlag $ haddockVerbosity flags
+ BuildHscolour flags -> fromFlag $ hscolourVerbosity flags
+
+buildingWhatDistPref :: BuildingWhat -> FilePath
+buildingWhatDistPref = \case
+ BuildNormal flags -> fromFlag $ buildDistPref flags
+ BuildRepl flags -> fromFlag $ replDistPref flags
+ BuildHaddock flags -> fromFlag $ haddockDistPref flags
+ BuildHscolour flags -> fromFlag $ hscolourDistPref flags
+
-- The test cases kinda have to be rewritten from the ground up... :/
-- hunitTests :: [Test]
-- hunitTests =
diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs
index f05957bc27166632b14ac4df5881d9f8878c4db0..64b22c5abee3f067af28b82e259b2cca9c07125e 100644
--- a/Cabal/src/Distribution/Simple/Utils.hs
+++ b/Cabal/src/Distribution/Simple/Utils.hs
@@ -1198,7 +1198,7 @@ findFileCwd verbosity cwd searchPath fileName =
findFirstFile
(cwd </>)
[ path </> fileName
- | path <- nub searchPath
+ | path <- ordNub searchPath
]
>>= maybe (dieWithException verbosity $ FindFileCwd fileName) return
@@ -1214,7 +1214,7 @@ findFileEx verbosity searchPath fileName =
findFirstFile
id
[ path </> fileName
- | path <- nub searchPath
+ | path <- ordNub searchPath
]
>>= maybe (dieWithException verbosity $ FindFileEx fileName) return
@@ -1230,8 +1230,8 @@ findFileWithExtension extensions searchPath baseName =
findFirstFile
id
[ path </> baseName <.> ext
- | path <- nub searchPath
- , ext <- nub extensions
+ | path <- ordNub searchPath
+ , ext <- ordNub extensions
]
-- | @since 3.4.0.0
@@ -1245,8 +1245,8 @@ findFileCwdWithExtension cwd extensions searchPath baseName =
findFirstFile
(cwd </>)
[ path </> baseName <.> ext
- | path <- nub searchPath
- , ext <- nub extensions
+ | path <- ordNub searchPath
+ , ext <- ordNub extensions
]
-- | @since 3.4.0.0
@@ -1264,8 +1264,8 @@ findAllFilesCwdWithExtension cwd extensions searchPath basename =
findAllFiles
(cwd </>)
[ path </> basename <.> ext
- | path <- nub searchPath
- , ext <- nub extensions
+ | path <- ordNub searchPath
+ , ext <- ordNub extensions
]
findAllFilesWithExtension
@@ -1277,8 +1277,8 @@ findAllFilesWithExtension extensions searchPath basename =
findAllFiles
id
[ path </> basename <.> ext
- | path <- nub searchPath
- , ext <- nub extensions
+ | path <- ordNub searchPath
+ , ext <- ordNub extensions
]
-- | Like 'findFileWithExtension' but returns which element of the search path
@@ -1292,8 +1292,8 @@ findFileWithExtension' extensions searchPath baseName =
findFirstFile
(uncurry (</>))
[ (path, baseName <.> ext)
- | path <- nub searchPath
- , ext <- nub extensions
+ | path <- ordNub searchPath
+ , ext <- ordNub extensions
]
findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
@@ -1535,7 +1535,7 @@ copyFilesWith
-> IO ()
copyFilesWith doCopy verbosity targetDir srcFiles = withFrozenCallStack $ do
-- Create parent directories for everything
- let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
+ let dirs = map (targetDir </>) . ordNub . map (takeDirectory . snd) $ srcFiles
traverse_ (createDirectoryIfMissingVerbose verbosity True) dirs
-- Copy all the files
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Lib.hs b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Lib.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9535fcd23fb6fb251cf77c227d0b69fd438e8d15
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Lib.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Lib where
+
+import Foreign.C (CInt (..))
+
+hello :: IO CInt
+hello = do
+ putStrLn "hello!"
+ return 11
+
+foreign export ccall "hello" hello :: IO CInt
+
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Main.hs b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Main.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2234f9e4ab2227e19293bb5f7bc3a8128d529a70
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/Main.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Main where
+
+import Foreign.C (CInt (..))
+
+foreign import ccall "meaning_of_life_c"
+ meaning_of_life_c :: IO CInt
+
+main :: IO ()
+main = do
+ secret <- meaning_of_life_c
+ -- The value 11 comes from the exported Lib.hello
+ if (secret == 11)
+ then putStrLn ("The secret is " ++ show secret)
+ else error ("Expected value 11, got " ++ show secret)
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.out b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.out
new file mode 100644
index 0000000000000000000000000000000000000000..cdfe4ab10de3b0ada8fe435a2ebe57daa533bbdf
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.out
@@ -0,0 +1,12 @@
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - csourcedepsstub-0.1 (lib) (first run)
+ - csourcedepsstub-0.1 (exe:csourcedeps-exe) (first run)
+Configuring library for csourcedepsstub-0.1...
+Preprocessing library for csourcedepsstub-0.1...
+Building library for csourcedepsstub-0.1...
+Configuring executable 'csourcedeps-exe' for csourcedepsstub-0.1...
+Preprocessing executable 'csourcedeps-exe' for csourcedepsstub-0.1...
+Building executable 'csourcedeps-exe' for csourcedepsstub-0.1...
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.project b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.project
new file mode 100644
index 0000000000000000000000000000000000000000..e6fdbadb4398bc0e333947b5fb8021778310d943
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.test.hs b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.test.hs
new file mode 100644
index 0000000000000000000000000000000000000000..fcfdc963f44a7b4bf9ca9b4ba432200c43609abc
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cabal.test.hs
@@ -0,0 +1,6 @@
+-- Tests whether an extra C source can depend on a _stub header generated by
+-- GHC compiling a Haskell module with a foreign export declaration
+
+import Test.Cabal.Prelude
+main = cabalTest $ do
+ cabal "v2-build" []
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cbits/clib.c b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cbits/clib.c
new file mode 100644
index 0000000000000000000000000000000000000000..3589ade00f3cab1100170c7e733b4184a4f92cdf
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/cbits/clib.c
@@ -0,0 +1,5 @@
+#include "Lib_stub.h"
+
+int meaning_of_life_c() {
+ return hello();
+}
diff --git a/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/csourcedepsstub.cabal b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/csourcedepsstub.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..61f0266993d96f95d9a3f7026209cd4b444c60b5
--- /dev/null
+++ b/cabal-testsuite/PackageTests/FFI/CSourceDependsStub/csourcedepsstub.cabal
@@ -0,0 +1,16 @@
+cabal-version: 2.2
+name: csourcedepsstub
+version: 0.1
+build-type: Simple
+
+library
+ build-depends: base
+ default-language: Haskell2010
+ include-dirs: cbits
+ c-sources: cbits/clib.c
+ exposed-modules: Lib
+
+executable csourcedeps-exe
+ main-is: Main.hs
+ build-depends: base, csourcedepsstub
+ default-language: Haskell2010