diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index c5dd237a5f89981de22142be27194819862fdd06..f4750e48e7917ccadf8a73b786cb2725fdc71b36 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -331,6 +331,9 @@ library
Distribution.Simple.Build.Macros.Z
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.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.ImplInfo
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 3d79a8356abf06a9c32b5c7471ba8166d77355f9..92378380325bd2669cb7f49f2f9004f423696102 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -81,46 +81,42 @@ module Distribution.Simple.GHC
import Distribution.Compat.Prelude
import Prelude ()
-import Control.Monad (forM_, msum)
-import Data.Char (isLower)
+import Control.Monad (forM_)
import qualified Data.Map as Map
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.Errors
-import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag)
+import Distribution.Simple.Flag (Flag (..), toFlag)
+import Distribution.Simple.GHC.Build
+ ( componentGhcOptions
+ , exeTargetName
+ , flibTargetName
+ , isDynamic
+ )
import Distribution.Simple.GHC.EnvironmentParser
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.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Program
-import qualified Distribution.Simple.Program.Ar as Ar
import Distribution.Simple.Program.Builtin (runghcProgram)
import Distribution.Simple.Program.GHC
import qualified Distribution.Simple.Program.HcPkg as HcPkg
-import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
-import Distribution.Simple.Setup.Config
import Distribution.Simple.Setup.Repl
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentLocalBuildInfo
-import Distribution.Types.PackageName.Magic
import Distribution.Types.ParStrat
import Distribution.Utils.NubList
-import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension
@@ -130,28 +126,22 @@ import System.Directory
, doesDirectoryExist
, doesFileExist
, getAppUserDataDirectory
- , getCurrentDirectory
, getDirectoryContents
- , makeRelativeToCurrentDirectory
- , removeFile
- , renameFile
)
import System.FilePath
- ( isRelative
- , replaceExtension
- , takeDirectory
- , takeExtension
+ ( takeDirectory
, (<.>)
, (</>)
)
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 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.Simple.GHC.BuildGeneric (GBuildMode (..), gbuild)
+import Distribution.Simple.GHC.BuildOrRepl (buildOrReplLib)
-- -----------------------------------------------------------------------------
-- Configuring
@@ -592,508 +582,6 @@ replLib
-> IO ()
replLib = buildOrReplLib . Just
-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
- -- TODO: Historically HPC files have been put into a directory which
- -- has the package name. I'm going to avoid changing this for
- -- now, but it would probably be better for this to be the
- -- component ID instead...
- pkg_name = prettyShow (PD.package pkg_descr)
- distPref = fromFlag $ configDistPref $ configFlags lbi
- hpcdir way
- | forRepl = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
- | 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
- }
- 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
-
-- | Start a REPL without loading any source files.
startInterpreter
:: Verbosity
@@ -1112,47 +600,6 @@ startInterpreter verbosity progdb comp platform packageDBs = do
(ghcProg, _) <- requireProgram verbosity ghcProgram progdb
runGHC verbosity ghcProg comp platform replOpts
-runReplOrWriteFlags
- :: Verbosity
- -> ConfiguredProgram
- -> Compiler
- -> Platform
- -> ReplOptions
- -> GhcOptions
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> PackageName
- -> 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})
-
-- -----------------------------------------------------------------------------
-- Building an executable or foreign library
@@ -1202,842 +649,6 @@ replExe
replExe replFlags v njobs pkg lbi =
gbuild v njobs pkg lbi . GReplExe replFlags
--- | 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
-
-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
-
-exeTargetName :: Platform -> Executable -> String
-exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform
-
--- | 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
-
-gbuildIsRepl :: GBuildMode -> Bool
-gbuildIsRepl (GBuildExe _) = False
-gbuildIsRepl (GReplExe _ _) = True
-gbuildIsRepl (GBuildFLib _) = False
-gbuildIsRepl (GReplFLib _ _) = True
-
-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"
-
-gbuildModDefFiles :: GBuildMode -> [FilePath]
-gbuildModDefFiles (GBuildExe _) = []
-gbuildModDefFiles (GReplExe _ _) = []
-gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
-gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib
-
--- | "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)
-
--- | 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]
- }
-
--- | 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++"]
-
--- | FilePath has a Haskell extension: .hs or .lhs
-isHaskell :: FilePath -> Bool
-isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
-
-replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
-replNoLoad replFlags l
- | replOptionsNoLoad replFlags == Flag True = mempty
- | otherwise = l
-
--- | 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
- distPref = fromFlag $ configDistPref $ configFlags lbi
- hpcdir way
- | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
- | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
- | 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
- , 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)
-
-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))))
-
--- | 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
-
--- | 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
-
--- | 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
-
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
libAbiHash
@@ -2092,19 +703,6 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
(ghcInvocation ghcProg comp platform ghcArgs)
return (takeWhile (not . isSpace) hash)
-componentGhcOptions
- :: Verbosity
- -> LocalBuildInfo
- -> BuildInfo
- -> ComponentLocalBuildInfo
- -> FilePath
- -> GhcOptions
-componentGhcOptions verbosity lbi =
- Internal.componentGhcOptions verbosity implInfo lbi
- where
- comp = compiler lbi
- implInfo = getImplInfo comp
-
componentCcGhcOptions
:: Verbosity
-> LocalBuildInfo
@@ -2413,15 +1011,3 @@ pkgRoot verbosity lbi = pkgRoot'
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
-
--- -----------------------------------------------------------------------------
--- Utils
-
-isDynamic :: Compiler -> Bool
-isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
-
-supportsDynamicToo :: Compiler -> Bool
-supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
-
-withExt :: FilePath -> String -> FilePath
-withExt fp ext = fp <.> if takeExtension fp /= ('.' : ext) then ext else ""
diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs
new file mode 100644
index 0000000000000000000000000000000000000000..4afd2a03a2f115ac56e3beef444524f20aa44d82
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/Build.hs
@@ -0,0 +1,262 @@
+module Distribution.Simple.GHC.Build
+ ( getRPaths
+ , runReplOrWriteFlags
+ , checkNeedsRecompilation
+ , replNoLoad
+ , componentGhcOptions
+ , supportsDynamicToo
+ , isDynamic
+ , flibBuildName
+ , flibTargetName
+ , exeTargetName
+ )
+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 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 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
+ -> 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})
diff --git a/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e4c4408b40b92a39fad474605948e6df8b404160
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/BuildGeneric.hs
@@ -0,0 +1,749 @@
+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.Flag (Flag (..), fromFlag, toFlag)
+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.Config
+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
+ distPref = fromFlag $ configDistPref $ configFlags lbi
+ hpcdir way
+ | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
+ | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
+ | 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
+ , 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
new file mode 100644
index 0000000000000000000000000000000000000000..9786470a99060a9aa0ca1953a23ed5c06a513ca1
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/GHC/BuildOrRepl.hs
@@ -0,0 +1,549 @@
+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.Pretty
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.Compiler
+import Distribution.Simple.Flag (Flag (..), fromFlag, toFlag)
+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.Config
+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
+ -- TODO: Historically HPC files have been put into a directory which
+ -- has the package name. I'm going to avoid changing this for
+ -- now, but it would probably be better for this to be the
+ -- component ID instead...
+ pkg_name = prettyShow (PD.package pkg_descr)
+ distPref = fromFlag $ configDistPref $ configFlags lbi
+ hpcdir way
+ | forRepl = mempty -- HPC is not supported in ghci
+ | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
+ | 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
+ }
+ 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