?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Support GHC 9.8 in cabal 3.10.2.0 (#9225)
[cabal.git] / Cabal / src / Distribution / Simple / GHC.hs
blob4387da26369d2ec237dce93f40b4f1d963f3879f
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE MultiWayIf #-}
3 {-# LANGUAGE RankNTypes #-}
4 {-# LANGUAGE TupleSections #-}
5 {-# LANGUAGE CPP #-}
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : Distribution.Simple.GHC
10 -- Copyright : Isaac Jones 2003-2007
11 -- License : BSD3
12 --
13 -- Maintainer : cabal-devel@haskell.org
14 -- Portability : portable
15 --
16 -- This is a fairly large module. It contains most of the GHC-specific code for
17 -- configuring, building and installing packages. It also exports a function
18 -- for finding out what packages are already installed. Configuring involves
19 -- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
20 -- this version of ghc supports and returning a 'Compiler' value.
21 --
22 -- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
23 -- what packages are installed.
24 --
25 -- Building is somewhat complex as there is quite a bit of information to take
26 -- into account. We have to build libs and programs, possibly for profiling and
27 -- shared libs. We have to support building libraries that will be usable by
28 -- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
29 -- using ghc. Linking, especially for @split-objs@ is remarkably complex,
30 -- partly because there tend to be 1,000's of @.o@ files and this can often be
31 -- more than we can pass to the @ld@ or @ar@ programs in one go.
32 --
33 -- Installing for libs and exes involves finding the right files and copying
34 -- them to the right places. One of the more tricky things about this module is
35 -- remembering the layout of files in the build directory (which is not
36 -- explicitly documented) and thus what search dirs are used for various kinds
37 -- of files.
38
39 module Distribution.Simple.GHC (
40 getGhcInfo,
41 configure,
42 getInstalledPackages,
43 getInstalledPackagesMonitorFiles,
44 getPackageDBContents,
45 buildLib, buildFLib, buildExe,
46 replLib, replFLib, replExe,
47 startInterpreter,
48 installLib, installFLib, installExe,
49 libAbiHash,
50 hcPkgInfo,
51 registerPackage,
52 componentGhcOptions,
53 componentCcGhcOptions,
54 getGhcAppDir,
55 getLibDir,
56 isDynamic,
57 getGlobalPackageDB,
58 pkgRoot,
59 -- * Constructing and deconstructing GHC environment files
60 Internal.GhcEnvironmentFileEntry(..),
61 Internal.simpleGhcEnvironmentFile,
62 Internal.renderGhcEnvironmentFile,
63 Internal.writeGhcEnvironmentFile,
64 Internal.ghcPlatformAndVersionString,
65 readGhcEnvironmentFile,
66 parseGhcEnvironmentFile,
67 ParseErrorExc(..),
68 -- * Version-specific implementation quirks
69 getImplInfo,
70 GhcImplInfo(..)
71 ) where
72
73 import Prelude ()
74 import Distribution.Compat.Prelude
75
76 import qualified Distribution.Simple.GHC.Internal as Internal
77 import Distribution.CabalSpecVersion
78 import Distribution.Simple.GHC.ImplInfo
79 import Distribution.Simple.GHC.EnvironmentParser
80 import Distribution.PackageDescription.Utils (cabalBug)
81 import Distribution.PackageDescription as PD
82 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
83 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
84 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
85 import qualified Distribution.Simple.PackageIndex as PackageIndex
86 import Distribution.Simple.LocalBuildInfo
87 import Distribution.Types.ComponentLocalBuildInfo
88 import qualified Distribution.Simple.Hpc as Hpc
89 import Distribution.Simple.BuildPaths
90 import Distribution.Simple.Utils
91 import Distribution.Package
92 import qualified Distribution.ModuleName as ModuleName
93 import Distribution.ModuleName (ModuleName)
94 import Distribution.Simple.Program
95 import Distribution.Simple.Program.Builtin (runghcProgram)
96 import qualified Distribution.Simple.Program.HcPkg as HcPkg
97 import qualified Distribution.Simple.Program.Ar as Ar
98 import qualified Distribution.Simple.Program.Ld as Ld
99 import qualified Distribution.Simple.Program.Strip as Strip
100 import Distribution.Simple.Program.GHC
101 import Distribution.Simple.Setup
102 import qualified Distribution.Simple.Setup as Cabal
103 import Distribution.Simple.Compiler
104 import Distribution.Version
105 import Distribution.System
106 import Distribution.Types.PackageName.Magic
107 import Distribution.Verbosity
108 import Distribution.Pretty
109 import Distribution.Utils.NubList
110 import Distribution.Utils.Path
111 import Language.Haskell.Extension
112
113 import Control.Monad (msum, forM_)
114 import Data.Char (isLower)
115 import qualified Data.Map as Map
116 import System.Directory
117 ( doesFileExist, doesDirectoryExist
118 , getAppUserDataDirectory, createDirectoryIfMissing
119 , canonicalizePath, removeFile, renameFile, getDirectoryContents
120 , makeRelativeToCurrentDirectory )
121 import System.FilePath ( (</>), (<.>), takeExtension
122 , takeDirectory, replaceExtension
123 ,isRelative )
124 import qualified System.Info
125 #ifndef mingw32_HOST_OS
126 import System.Posix (createSymbolicLink)
127 #endif /* mingw32_HOST_OS */
128
129 -- -----------------------------------------------------------------------------
130 -- Configuring
131
132 configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
133 -> ProgramDb
134 -> IO (Compiler, Maybe Platform, ProgramDb)
135 configure verbosity hcPath hcPkgPath conf0 = do
136
137 (ghcProg, ghcVersion, progdb1) <-
138 requireProgramVersion verbosity ghcProgram
139 (orLaterVersion (mkVersion [7,0,1]))
140 (userMaybeSpecifyPath "ghc" hcPath conf0)
141 let implInfo = ghcVersionImplInfo ghcVersion
142
143 -- Cabal currently supports ghc >= 7.0.1 && < 9.10
144 -- ... and the following odd development version
145 unless (ghcVersion < mkVersion [9,10]) $
146 warn verbosity $
147 "Unknown/unsupported 'ghc' version detected "
148 ++ "(Cabal " ++ prettyShow cabalVersion ++ " supports 'ghc' version < 9.10): "
149 ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion
150
151 -- This is slightly tricky, we have to configure ghc first, then we use the
152 -- location of ghc to help find ghc-pkg in the case that the user did not
153 -- specify the location of ghc-pkg directly:
154 (ghcPkgProg, ghcPkgVersion, progdb2) <-
155 requireProgramVersion verbosity ghcPkgProgram {
156 programFindLocation = guessGhcPkgFromGhcPath ghcProg
157 }
158 anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
159
160 when (ghcVersion /= ghcPkgVersion) $ die' verbosity $
161 "Version mismatch between ghc and ghc-pkg: "
162 ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion ++ " "
163 ++ programPath ghcPkgProg ++ " is version " ++ prettyShow ghcPkgVersion
164
165 -- Likewise we try to find the matching hsc2hs and haddock programs.
166 let hsc2hsProgram' = hsc2hsProgram {
167 programFindLocation = guessHsc2hsFromGhcPath ghcProg
168 }
169 haddockProgram' = haddockProgram {
170 programFindLocation = guessHaddockFromGhcPath ghcProg
171 }
172 hpcProgram' = hpcProgram {
173 programFindLocation = guessHpcFromGhcPath ghcProg
174 }
175 runghcProgram' = runghcProgram {
176 programFindLocation = guessRunghcFromGhcPath ghcProg
177 }
178 progdb3 = addKnownProgram haddockProgram' $
179 addKnownProgram hsc2hsProgram' $
180 addKnownProgram hpcProgram' $
181 addKnownProgram runghcProgram' progdb2
182
183 languages <- Internal.getLanguages verbosity implInfo ghcProg
184 extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
185
186 ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
187 let ghcInfoMap = Map.fromList ghcInfo
188 filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id
189 extensions =
190 -- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214
191 filterJS $
192 -- see 'filterExtTH' comment below
193 filterExtTH $
194 extensions0
195
196 -- starting with GHC 8.0, `TemplateHaskell` will be omitted from
197 -- `--supported-extensions` when it's not available.
198 -- for older GHCs we can use the "Have interpreter" property to
199 -- filter out `TemplateHaskell`
200 filterExtTH | ghcVersion < mkVersion [8]
201 , Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap
202 = filterExt TemplateHaskell
203 | otherwise = id
204
205 filterExt ext = filter ((/= EnableExtension ext) . fst)
206
207 let comp = Compiler {
208 compilerId = CompilerId GHC ghcVersion,
209 compilerAbiTag = NoAbiTag,
210 compilerCompat = [],
211 compilerLanguages = languages,
212 compilerExtensions = extensions,
213 compilerProperties = ghcInfoMap
214 }
215 compPlatform = Internal.targetPlatform ghcInfo
216 -- configure gcc and ld
217 progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
218 return (comp, compPlatform, progdb4)
219
220 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
221 -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
222 -- for a versioned or unversioned ghc-pkg in the same dir, that is:
223 --
224 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
225 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
226 -- > /usr/local/bin/ghc-pkg(.exe)
227 --
228 guessToolFromGhcPath :: Program -> ConfiguredProgram
229 -> Verbosity -> ProgramSearchPath
230 -> IO (Maybe (FilePath, [FilePath]))
231 guessToolFromGhcPath tool ghcProg verbosity searchpath
232 = do let toolname = programName tool
233 given_path = programPath ghcProg
234 given_dir = takeDirectory given_path
235 real_path <- canonicalizePath given_path
236 let real_dir = takeDirectory real_path
237 versionSuffix path = takeVersionSuffix (dropExeExtension path)
238 given_suf = versionSuffix given_path
239 real_suf = versionSuffix real_path
240 guessNormal dir = dir </> toolname <.> exeExtension buildPlatform
241 guessGhcVersioned dir suf = dir </> (toolname ++ "-ghc" ++ suf)
242 <.> exeExtension buildPlatform
243 guessVersioned dir suf = dir </> (toolname ++ suf)
244 <.> exeExtension buildPlatform
245 mkGuesses dir suf | null suf = [guessNormal dir]
246 | otherwise = [guessGhcVersioned dir suf,
247 guessVersioned dir suf,
248 guessNormal dir]
249 -- order matters here, see https://github.com/haskell/cabal/issues/7390
250 guesses = (if real_path == given_path
251 then []
252 else mkGuesses real_dir real_suf)
253 ++ mkGuesses given_dir given_suf
254 info verbosity $ "looking for tool " ++ toolname
255 ++ " near compiler in " ++ given_dir
256 debug verbosity $ "candidate locations: " ++ show guesses
257 exists <- traverse doesFileExist guesses
258 case [ file | (file, True) <- zip guesses exists ] of
259 -- If we can't find it near ghc, fall back to the usual
260 -- method.
261 [] -> programFindLocation tool verbosity searchpath
262 (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
263 let lookedAt = map fst
264 . takeWhile (\(_file, exist) -> not exist)
265 $ zip guesses exists
266 return (Just (fp, lookedAt))
267
268 where takeVersionSuffix :: FilePath -> String
269 takeVersionSuffix = takeWhileEndLE isSuffixChar
270
271 isSuffixChar :: Char -> Bool
272 isSuffixChar c = isDigit c || c == '.' || c == '-'
273
274 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
275 -- corresponding ghc-pkg, we try looking for both a versioned and unversioned
276 -- ghc-pkg in the same dir, that is:
277 --
278 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
279 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
280 -- > /usr/local/bin/ghc-pkg(.exe)
281 --
282 guessGhcPkgFromGhcPath :: ConfiguredProgram
283 -> Verbosity -> ProgramSearchPath
284 -> IO (Maybe (FilePath, [FilePath]))
285 guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
286
287 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
288 -- corresponding hsc2hs, we try looking for both a versioned and unversioned
289 -- hsc2hs in the same dir, that is:
290 --
291 -- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
292 -- > /usr/local/bin/hsc2hs-6.6.1(.exe)
293 -- > /usr/local/bin/hsc2hs(.exe)
294 --
295 guessHsc2hsFromGhcPath :: ConfiguredProgram
296 -> Verbosity -> ProgramSearchPath
297 -> IO (Maybe (FilePath, [FilePath]))
298 guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
299
300 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
301 -- corresponding haddock, we try looking for both a versioned and unversioned
302 -- haddock in the same dir, that is:
303 --
304 -- > /usr/local/bin/haddock-ghc-6.6.1(.exe)
305 -- > /usr/local/bin/haddock-6.6.1(.exe)
306 -- > /usr/local/bin/haddock(.exe)
307 --
308 guessHaddockFromGhcPath :: ConfiguredProgram
309 -> Verbosity -> ProgramSearchPath
310 -> IO (Maybe (FilePath, [FilePath]))
311 guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
312
313 guessHpcFromGhcPath :: ConfiguredProgram
314 -> Verbosity -> ProgramSearchPath
315 -> IO (Maybe (FilePath, [FilePath]))
316 guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
317
318 guessRunghcFromGhcPath :: ConfiguredProgram
319 -> Verbosity -> ProgramSearchPath
320 -> IO (Maybe (FilePath, [FilePath]))
321 guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
322
323
324 getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
325 getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
326 where
327 version = fromMaybe (error "GHC.getGhcInfo: no ghc version") $ programVersion ghcProg
328 implInfo = ghcVersionImplInfo version
329
330 -- | Given a single package DB, return all installed packages.
331 getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
332 -> IO InstalledPackageIndex
333 getPackageDBContents verbosity packagedb progdb = do
334 pkgss <- getInstalledPackages' verbosity [packagedb] progdb
335 toPackageIndex verbosity pkgss progdb
336
337 -- | Given a package DB stack, return all installed packages.
338 getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack
339 -> ProgramDb
340 -> IO InstalledPackageIndex
341 getInstalledPackages verbosity comp packagedbs progdb = do
342 checkPackageDbEnvVar verbosity
343 checkPackageDbStack verbosity comp packagedbs
344 pkgss <- getInstalledPackages' verbosity packagedbs progdb
345 index <- toPackageIndex verbosity pkgss progdb
346 return $! hackRtsPackage index
347
348 where
349 hackRtsPackage index =
350 case PackageIndex.lookupPackageName index (mkPackageName "rts") of
351 [(_,[rts])]
352 -> PackageIndex.insert (removeMingwIncludeDir rts) index
353 _ -> index -- No (or multiple) ghc rts package is registered!!
354 -- Feh, whatever, the ghc test suite does some crazy stuff.
355
356 -- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
357 -- @PackageIndex@. Helper function used by 'getPackageDBContents' and
358 -- 'getInstalledPackages'.
359 toPackageIndex :: Verbosity
360 -> [(PackageDB, [InstalledPackageInfo])]
361 -> ProgramDb
362 -> IO InstalledPackageIndex
363 toPackageIndex verbosity pkgss progdb = do
364 -- On Windows, various fields have $topdir/foo rather than full
365 -- paths. We need to substitute the right value in so that when
366 -- we, for example, call gcc, we have proper paths to give it.
367 topDir <- getLibDir' verbosity ghcProg
368 let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
369 | (_, pkgs) <- pkgss ]
370 return $! mconcat indices
371
372 where
373 ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
374
375 -- | Return the 'FilePath' to the GHC application data directory.
376 --
377 -- @since 3.4.0.0
378 getGhcAppDir :: IO FilePath
379 getGhcAppDir = getAppUserDataDirectory "ghc"
380
381 getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
382 getLibDir verbosity lbi =
383 dropWhileEndLE isSpace `fmap`
384 getDbProgramOutput verbosity ghcProgram
385 (withPrograms lbi) ["--print-libdir"]
386
387 getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
388 getLibDir' verbosity ghcProg =
389 dropWhileEndLE isSpace `fmap`
390 getProgramOutput verbosity ghcProg ["--print-libdir"]
391
392
393 -- | Return the 'FilePath' to the global GHC package database.
394 getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
395 getGlobalPackageDB verbosity ghcProg =
396 dropWhileEndLE isSpace `fmap`
397 getProgramOutput verbosity ghcProg ["--print-global-package-db"]
398
399 -- | Return the 'FilePath' to the per-user GHC package database.
400 getUserPackageDB
401 :: Verbosity -> ConfiguredProgram -> Platform -> IO FilePath
402 getUserPackageDB _verbosity ghcProg platform = do
403 -- It's rather annoying that we have to reconstruct this, because ghc
404 -- hides this information from us otherwise. But for certain use cases
405 -- like change monitoring it really can't remain hidden.
406 appdir <- getGhcAppDir
407 return (appdir </> platformAndVersion </> packageConfFileName)
408 where
409 platformAndVersion = Internal.ghcPlatformAndVersionString
410 platform ghcVersion
411 packageConfFileName = "package.conf.d"
412 ghcVersion = fromMaybe (error "GHC.getUserPackageDB: no ghc version") $ programVersion ghcProg
413
414 checkPackageDbEnvVar :: Verbosity -> IO ()
415 checkPackageDbEnvVar verbosity =
416 Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
417
418 checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
419 checkPackageDbStack verbosity comp =
420 if flagPackageConf implInfo
421 then checkPackageDbStackPre76 verbosity
422 else checkPackageDbStackPost76 verbosity
423 where implInfo = ghcVersionImplInfo (compilerVersion comp)
424
425 checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
426 checkPackageDbStackPost76 _ (GlobalPackageDB:rest)
427 | GlobalPackageDB `notElem` rest = return ()
428 checkPackageDbStackPost76 verbosity rest
429 | GlobalPackageDB `elem` rest =
430 die' verbosity $ "If the global package db is specified, it must be "
431 ++ "specified first and cannot be specified multiple times"
432 checkPackageDbStackPost76 _ _ = return ()
433
434 checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
435 checkPackageDbStackPre76 _ (GlobalPackageDB:rest)
436 | GlobalPackageDB `notElem` rest = return ()
437 checkPackageDbStackPre76 verbosity rest
438 | GlobalPackageDB `notElem` rest =
439 die' verbosity $
440 "With current ghc versions the global package db is always used "
441 ++ "and must be listed first. This ghc limitation is lifted in GHC 7.6,"
442 ++ "see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"
443 checkPackageDbStackPre76 verbosity _ =
444 die' verbosity $ "If the global package db is specified, it must be "
445 ++ "specified first and cannot be specified multiple times"
446
447 -- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
448 -- breaks when you want to use a different gcc, so we need to filter
449 -- it out.
450 removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
451 removeMingwIncludeDir pkg =
452 let ids = InstalledPackageInfo.includeDirs pkg
453 ids' = filter (not . ("mingw" `isSuffixOf`)) ids
454 in pkg { InstalledPackageInfo.includeDirs = ids' }
455
456 -- | Get the packages from specific PackageDBs, not cumulative.
457 --
458 getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
459 -> IO [(PackageDB, [InstalledPackageInfo])]
460 getInstalledPackages' verbosity packagedbs progdb =
461 sequenceA
462 [ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
463 return (packagedb, pkgs)
464 | packagedb <- packagedbs ]
465
466 getInstalledPackagesMonitorFiles :: Verbosity -> Platform
467 -> ProgramDb
468 -> [PackageDB]
469 -> IO [FilePath]
470 getInstalledPackagesMonitorFiles verbosity platform progdb =
471 traverse getPackageDBPath
472 where
473 getPackageDBPath :: PackageDB -> IO FilePath
474 getPackageDBPath GlobalPackageDB =
475 selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
476
477 getPackageDBPath UserPackageDB =
478 selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
479
480 getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
481
482 -- GHC has old style file dbs, and new style directory dbs.
483 -- Note that for dir style dbs, we only need to monitor the cache file, not
484 -- the whole directory. The ghc program itself only reads the cache file
485 -- so it's safe to only monitor this one file.
486 selectMonitorFile path = do
487 isFileStyle <- doesFileExist path
488 if isFileStyle then return path
489 else return (path </> "package.cache")
490
491 ghcProg = fromMaybe (error "GHC.toPackageIndex: no ghc program") $ lookupProgram ghcProgram progdb
492
493
494 -- -----------------------------------------------------------------------------
495 -- Building a library
496
497 buildLib :: Verbosity -> Cabal.Flag (Maybe Int)
498 -> PackageDescription -> LocalBuildInfo
499 -> Library -> ComponentLocalBuildInfo -> IO ()
500 buildLib = buildOrReplLib Nothing
501
502 replLib :: ReplOptions -> Verbosity
503 -> Cabal.Flag (Maybe Int) -> PackageDescription
504 -> LocalBuildInfo -> Library
505 -> ComponentLocalBuildInfo -> IO ()
506 replLib = buildOrReplLib . Just
507
508 buildOrReplLib :: Maybe ReplOptions -> Verbosity
509 -> Cabal.Flag (Maybe Int) -> PackageDescription
510 -> LocalBuildInfo -> Library
511 -> ComponentLocalBuildInfo -> IO ()
512 buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
513 let uid = componentUnitId clbi
514 libTargetDir = componentBuildDir lbi clbi
515 whenVanillaLib forceVanilla =
516 when (forceVanilla || withVanillaLib lbi)
517 whenProfLib = when (withProfLib lbi)
518 whenSharedLib forceShared =
519 when (forceShared || withSharedLib lbi)
520 whenStaticLib forceStatic =
521 when (forceStatic || withStaticLib lbi)
522 whenGHCiLib = when (withGHCiLib lbi)
523 forRepl = maybe False (const True) mReplFlags
524 whenReplLib = when forRepl
525 replFlags = fromMaybe mempty mReplFlags
526 comp = compiler lbi
527 ghcVersion = compilerVersion comp
528 implInfo = getImplInfo comp
529 platform@(Platform hostArch hostOS) = hostPlatform lbi
530 hasJsSupport = hostArch == JavaScript
531 has_code = not (componentIsIndefinite clbi)
532
533 relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir
534
535 (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
536 let runGhcProg = runGHC verbosity ghcProg comp platform
537
538 let libBi = libBuildInfo lib
539
540 -- ensure extra lib dirs exist before passing to ghc
541 cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs libBi)
542 cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic libBi)
543
544
545 let isGhcDynamic = isDynamic comp
546 dynamicTooSupported = supportsDynamicToo comp
547 doingTH = usesTemplateHaskellOrQQ libBi
548 forceVanillaLib = doingTH && not isGhcDynamic
549 forceSharedLib = doingTH && isGhcDynamic
550 -- TH always needs default libs, even when building for profiling
551
552 -- Determine if program coverage should be enabled and if so, what
553 -- '-hpcdir' should be.
554 let isCoverageEnabled = libCoverage lbi
555 -- TODO: Historically HPC files have been put into a directory which
556 -- has the package name. I'm going to avoid changing this for
557 -- now, but it would probably be better for this to be the
558 -- component ID instead...
559 pkg_name = prettyShow (PD.package pkg_descr)
560 distPref = fromFlag $ configDistPref $ configFlags lbi
561 hpcdir way
562 | forRepl = mempty -- HPC is not supported in ghci
563 | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
564 | otherwise = mempty
565
566 createDirectoryIfMissingVerbose verbosity True libTargetDir
567 -- TODO: do we need to put hs-boot files into place for mutually recursive
568 -- modules?
569 let cLikeSources = fromNubListR $ mconcat
570 [ toNubListR (cSources libBi)
571 , toNubListR (cxxSources libBi)
572 , toNubListR (cmmSources libBi)
573 , toNubListR (asmSources libBi)
574 , if hasJsSupport
575 -- JS files are C-like with GHC's JS backend: they are
576 -- "compiled" into `.o` files (renamed with a header).
577 -- This is a difference from GHCJS, for which we only
578 -- pass the JS files at link time.
579 then toNubListR (jsSources libBi)
580 else mempty
581 ]
582 cLikeObjs = map (`replaceExtension` objExtension) cLikeSources
583 baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
584 vanillaOpts = baseOpts `mappend` mempty {
585 ghcOptMode = toFlag GhcModeMake,
586 ghcOptNumJobs = numJobs,
587 ghcOptInputModules = toNubListR $ allLibModules lib clbi,
588 ghcOptHPCDir = hpcdir Hpc.Vanilla
589 }
590
591 profOpts = vanillaOpts `mappend` mempty {
592 ghcOptProfilingMode = toFlag True,
593 ghcOptProfilingAuto = Internal.profDetailLevelFlag True
594 (withProfLibDetail lbi),
595 ghcOptHiSuffix = toFlag "p_hi",
596 ghcOptObjSuffix = toFlag "p_o",
597 ghcOptExtra = hcProfOptions GHC libBi,
598 ghcOptHPCDir = hpcdir Hpc.Prof
599 }
600
601 sharedOpts = vanillaOpts `mappend` mempty {
602 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
603 ghcOptFPic = toFlag True,
604 ghcOptHiSuffix = toFlag "dyn_hi",
605 ghcOptObjSuffix = toFlag "dyn_o",
606 ghcOptExtra = hcSharedOptions GHC libBi,
607 ghcOptHPCDir = hpcdir Hpc.Dyn
608 }
609 linkerOpts = mempty {
610 ghcOptLinkOptions = PD.ldOptions libBi
611 ++ [ "-static"
612 | withFullyStaticExe lbi ]
613 -- Pass extra `ld-options` given
614 -- through to GHC's linker.
615 ++ maybe [] programOverrideArgs
616 (lookupProgram ldProgram (withPrograms lbi)),
617 ghcOptLinkLibs = if withFullyStaticExe lbi
618 then extraLibsStatic libBi
619 else extraLibs libBi,
620 ghcOptLinkLibPath = toNubListR $
621 if withFullyStaticExe lbi
622 then cleanedExtraLibDirsStatic
623 else cleanedExtraLibDirs,
624 ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
625 ghcOptLinkFrameworkDirs = toNubListR $
626 PD.extraFrameworkDirs libBi,
627 ghcOptInputFiles = toNubListR
628 [relLibTargetDir </> x | x <- cLikeObjs]
629 }
630 replOpts = vanillaOpts {
631 ghcOptExtra = Internal.filterGhciFlags
632 (ghcOptExtra vanillaOpts)
633 <> replOptionsFlags replFlags,
634 ghcOptNumJobs = mempty,
635 ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules vanillaOpts)
636 }
637 `mappend` linkerOpts
638 `mappend` mempty {
639 ghcOptMode = toFlag GhcModeInteractive,
640 ghcOptOptimisation = toFlag GhcNoOptimisation
641 }
642
643 vanillaSharedOpts = vanillaOpts `mappend` mempty {
644 ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
645 ghcOptDynHiSuffix = toFlag "dyn_hi",
646 ghcOptDynObjSuffix = toFlag "dyn_o",
647 ghcOptHPCDir = hpcdir Hpc.Dyn
648 }
649
650 unless (forRepl || null (allLibModules lib clbi)) $
651 do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
652 shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts)
653 useDynToo = dynamicTooSupported &&
654 (forceVanillaLib || withVanillaLib lbi) &&
655 (forceSharedLib || withSharedLib lbi) &&
656 null (hcSharedOptions GHC libBi)
657 if not has_code
658 then vanilla
659 else
660 if useDynToo
661 then do
662 runGhcProg vanillaSharedOpts
663 case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
664 (Cabal.Flag dynDir, Cabal.Flag vanillaDir) ->
665 -- When the vanilla and shared library builds are done
666 -- in one pass, only one set of HPC module interfaces
667 -- are generated. This set should suffice for both
668 -- static and dynamically linked executables. We copy
669 -- the modules interfaces so they are available under
670 -- both ways.
671 copyDirectoryRecursive verbosity dynDir vanillaDir
672 _ -> return ()
673 else if isGhcDynamic
674 then do shared; vanilla
675 else do vanilla; shared
676 whenProfLib (runGhcProg profOpts)
677
678 -- Build any C++ sources separately.
679 unless (not has_code || null (cxxSources libBi)) $ do
680 info verbosity "Building C++ Sources..."
681 sequence_
682 [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo
683 lbi libBi clbi relLibTargetDir filename
684 vanillaCxxOpts = if isGhcDynamic
685 then baseCxxOpts { ghcOptFPic = toFlag True }
686 else baseCxxOpts
687 profCxxOpts = vanillaCxxOpts `mappend` mempty {
688 ghcOptProfilingMode = toFlag True,
689 ghcOptObjSuffix = toFlag "p_o"
690 }
691 sharedCxxOpts = vanillaCxxOpts `mappend` mempty {
692 ghcOptFPic = toFlag True,
693 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
694 ghcOptObjSuffix = toFlag "dyn_o"
695 }
696 odir = fromFlag (ghcOptObjDir vanillaCxxOpts)
697 createDirectoryIfMissingVerbose verbosity True odir
698 let runGhcProgIfNeeded cxxOpts = do
699 needsRecomp <- checkNeedsRecompilation filename cxxOpts
700 when needsRecomp $ runGhcProg cxxOpts
701 runGhcProgIfNeeded vanillaCxxOpts
702 unless forRepl $
703 whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCxxOpts)
704 unless forRepl $ whenProfLib (runGhcProgIfNeeded profCxxOpts)
705 | filename <- cxxSources libBi]
706
707 -- build any C sources
708 let (cSrcs', others) = partition (\filepath -> ".c"`isSuffixOf` filepath) (cSources libBi)
709 unless (not has_code || null cSrcs') $ do
710 info verbosity "Building C Sources..."
711 unless (null others) $ do
712 let files = intercalate ", " others
713 let libraryName = case libName lib of
714 LMainLibName -> "the main library"
715 LSubLibName name -> "library " <> prettyShow name
716 warn verbosity $ unlines
717 [ "The following files listed in " <> libraryName <> "'s c-sources will not be used: " <> files <> "."
718 , "Header files should be in the 'include' or 'install-include' stanza."
719 , "See https://cabal.readthedocs.io/en/3.10/cabal-package.html#pkg-field-includes"
720 ]
721 forM_ cSrcs' $ \filename -> do
722 let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
723 lbi libBi clbi relLibTargetDir filename
724 vanillaCcOpts = if isGhcDynamic
725 -- Dynamic GHC requires C sources to be built
726 -- with -fPIC for REPL to work. See #2207.
727 then baseCcOpts { ghcOptFPic = toFlag True }
728 else baseCcOpts
729 profCcOpts = vanillaCcOpts `mappend` mempty {
730 ghcOptProfilingMode = toFlag True,
731 ghcOptObjSuffix = toFlag "p_o"
732 }
733 sharedCcOpts = vanillaCcOpts `mappend` mempty {
734 ghcOptFPic = toFlag True,
735 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
736 ghcOptObjSuffix = toFlag "dyn_o"
737 }
738 odir = fromFlag (ghcOptObjDir vanillaCcOpts)
739 createDirectoryIfMissingVerbose verbosity True odir
740 let runGhcProgIfNeeded ccOpts = do
741 needsRecomp <- checkNeedsRecompilation filename ccOpts
742 when needsRecomp $ runGhcProg ccOpts
743 runGhcProgIfNeeded vanillaCcOpts
744 unless forRepl $
745 whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCcOpts)
746 unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts)
747
748 -- build any JS sources
749 unless (not has_code || not hasJsSupport || null (jsSources libBi)) $ do
750 info verbosity "Building JS Sources..."
751 sequence_
752 [ do let vanillaJsOpts = Internal.componentJsGhcOptions verbosity implInfo
753 lbi libBi clbi relLibTargetDir filename
754 profJsOpts = vanillaJsOpts `mappend` mempty {
755 ghcOptProfilingMode = toFlag True,
756 ghcOptObjSuffix = toFlag "p_o"
757 }
758 odir = fromFlag (ghcOptObjDir vanillaJsOpts)
759 createDirectoryIfMissingVerbose verbosity True odir
760 let runGhcProgIfNeeded jsOpts = do
761 needsRecomp <- checkNeedsRecompilation filename jsOpts
762 when needsRecomp $ runGhcProg jsOpts
763 runGhcProgIfNeeded vanillaJsOpts
764 unless forRepl $ whenProfLib (runGhcProgIfNeeded profJsOpts)
765 | filename <- jsSources libBi]
766
767 -- build any ASM sources
768 unless (not has_code || null (asmSources libBi)) $ do
769 info verbosity "Building Assembler Sources..."
770 sequence_
771 [ do let baseAsmOpts = Internal.componentAsmGhcOptions verbosity implInfo
772 lbi libBi clbi relLibTargetDir filename
773 vanillaAsmOpts = if isGhcDynamic
774 -- Dynamic GHC requires objects to be built
775 -- with -fPIC for REPL to work. See #2207.
776 then baseAsmOpts { ghcOptFPic = toFlag True }
777 else baseAsmOpts
778 profAsmOpts = vanillaAsmOpts `mappend` mempty {
779 ghcOptProfilingMode = toFlag True,
780 ghcOptObjSuffix = toFlag "p_o"
781 }
782 sharedAsmOpts = vanillaAsmOpts `mappend` mempty {
783 ghcOptFPic = toFlag True,
784 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
785 ghcOptObjSuffix = toFlag "dyn_o"
786 }
787 odir = fromFlag (ghcOptObjDir vanillaAsmOpts)
788 createDirectoryIfMissingVerbose verbosity True odir
789 let runGhcProgIfNeeded asmOpts = do
790 needsRecomp <- checkNeedsRecompilation filename asmOpts
791 when needsRecomp $ runGhcProg asmOpts
792 runGhcProgIfNeeded vanillaAsmOpts
793 unless forRepl $
794 whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedAsmOpts)
795 unless forRepl $ whenProfLib (runGhcProgIfNeeded profAsmOpts)
796 | filename <- asmSources libBi]
797
798 -- build any Cmm sources
799 unless (not has_code || null (cmmSources libBi)) $ do
800 info verbosity "Building C-- Sources..."
801 sequence_
802 [ do let baseCmmOpts = Internal.componentCmmGhcOptions verbosity implInfo
803 lbi libBi clbi relLibTargetDir filename
804 vanillaCmmOpts = if isGhcDynamic
805 -- Dynamic GHC requires C sources to be built
806 -- with -fPIC for REPL to work. See #2207.
807 then baseCmmOpts { ghcOptFPic = toFlag True }
808 else baseCmmOpts
809 profCmmOpts = vanillaCmmOpts `mappend` mempty {
810 ghcOptProfilingMode = toFlag True,
811 ghcOptObjSuffix = toFlag "p_o"
812 }
813 sharedCmmOpts = vanillaCmmOpts `mappend` mempty {
814 ghcOptFPic = toFlag True,
815 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
816 ghcOptObjSuffix = toFlag "dyn_o"
817 }
818 odir = fromFlag (ghcOptObjDir vanillaCmmOpts)
819 createDirectoryIfMissingVerbose verbosity True odir
820 let runGhcProgIfNeeded cmmOpts = do
821 needsRecomp <- checkNeedsRecompilation filename cmmOpts
822 when needsRecomp $ runGhcProg cmmOpts
823 runGhcProgIfNeeded vanillaCmmOpts
824 unless forRepl $
825 whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCmmOpts)
826 unless forRepl $ whenProfLib (runGhcProgIfNeeded profCmmOpts)
827 | filename <- cmmSources libBi]
828
829 -- TODO: problem here is we need the .c files built first, so we can load them
830 -- with ghci, but .c files can depend on .h files generated by ghc by ffi
831 -- exports.
832 whenReplLib $ do
833 when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
834 runGhcProg replOpts
835
836 -- link:
837 when has_code . unless forRepl $ do
838 info verbosity "Linking..."
839 let cLikeProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
840 cLikeSources
841 cLikeSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
842 cLikeSources
843 compiler_id = compilerId (compiler lbi)
844 vanillaLibFilePath = relLibTargetDir </> mkLibName uid
845 profileLibFilePath = relLibTargetDir </> mkProfLibName uid
846 sharedLibFilePath = relLibTargetDir </>
847 mkSharedLibName (hostPlatform lbi) compiler_id uid
848 staticLibFilePath = relLibTargetDir </>
849 mkStaticLibName (hostPlatform lbi) compiler_id uid
850 ghciLibFilePath = relLibTargetDir </> Internal.mkGHCiLibName uid
851 ghciProfLibFilePath = relLibTargetDir </> Internal.mkGHCiProfLibName uid
852 libInstallPath = libdir $
853 absoluteComponentInstallDirs
854 pkg_descr lbi uid NoCopyDest
855 sharedLibInstallPath = libInstallPath </>
856 mkSharedLibName (hostPlatform lbi) compiler_id uid
857
858 stubObjs <- catMaybes <$> sequenceA
859 [ findFileWithExtension [objExtension] [libTargetDir]
860 (ModuleName.toFilePath x ++"_stub")
861 | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
862 , x <- allLibModules lib clbi ]
863 stubProfObjs <- catMaybes <$> sequenceA
864 [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
865 (ModuleName.toFilePath x ++"_stub")
866 | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
867 , x <- allLibModules lib clbi ]
868 stubSharedObjs <- catMaybes <$> sequenceA
869 [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
870 (ModuleName.toFilePath x ++"_stub")
871 | ghcVersion < mkVersion [7,2] -- ghc-7.2+ does not make _stub.o files
872 , x <- allLibModules lib clbi ]
873
874 hObjs <- Internal.getHaskellObjects implInfo lib lbi clbi
875 relLibTargetDir objExtension True
876 hProfObjs <-
877 if withProfLib lbi
878 then Internal.getHaskellObjects implInfo lib lbi clbi
879 relLibTargetDir ("p_" ++ objExtension) True
880 else return []
881 hSharedObjs <-
882 if withSharedLib lbi
883 then Internal.getHaskellObjects implInfo lib lbi clbi
884 relLibTargetDir ("dyn_" ++ objExtension) False
885 else return []
886
887 unless (null hObjs && null cLikeObjs && null stubObjs) $ do
888 rpaths <- getRPaths lbi clbi
889
890 let staticObjectFiles =
891 hObjs
892 ++ map (relLibTargetDir </>) cLikeObjs
893 ++ stubObjs
894 profObjectFiles =
895 hProfObjs
896 ++ map (relLibTargetDir </>) cLikeProfObjs
897 ++ stubProfObjs
898 dynamicObjectFiles =
899 hSharedObjs
900 ++ map (relLibTargetDir </>) cLikeSharedObjs
901 ++ stubSharedObjs
902 -- After the relocation lib is created we invoke ghc -shared
903 -- with the dependencies spelled out as -package arguments
904 -- and ghc invokes the linker with the proper library paths
905 ghcSharedLinkArgs =
906 mempty {
907 ghcOptShared = toFlag True,
908 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
909 ghcOptInputFiles = toNubListR dynamicObjectFiles,
910 ghcOptOutputFile = toFlag sharedLibFilePath,
911 ghcOptExtra = hcSharedOptions GHC libBi,
912 -- For dynamic libs, Mac OS/X needs to know the install location
913 -- at build time. This only applies to GHC < 7.8 - see the
914 -- discussion in #1660.
915 ghcOptDylibName = if hostOS == OSX
916 && ghcVersion < mkVersion [7,8]
917 then toFlag sharedLibInstallPath
918 else mempty,
919 ghcOptHideAllPackages = toFlag True,
920 ghcOptNoAutoLinkPackages = toFlag True,
921 ghcOptPackageDBs = withPackageDB lbi,
922 ghcOptThisUnitId = case clbi of
923 LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
924 -> toFlag pk
925 _ -> mempty,
926 ghcOptThisComponentId = case clbi of
927 LibComponentLocalBuildInfo
928 { componentInstantiatedWith = insts } ->
929 if null insts
930 then mempty
931 else toFlag (componentComponentId clbi)
932 _ -> mempty,
933 ghcOptInstantiatedWith = case clbi of
934 LibComponentLocalBuildInfo
935 { componentInstantiatedWith = insts }
936 -> insts
937 _ -> [],
938 ghcOptPackages = toNubListR $
939 Internal.mkGhcOptPackages clbi ,
940 ghcOptLinkLibs = extraLibs libBi,
941 ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs,
942 ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
943 ghcOptLinkFrameworkDirs =
944 toNubListR $ PD.extraFrameworkDirs libBi,
945 ghcOptRPaths = rpaths
946 }
947 ghcStaticLinkArgs =
948 mempty {
949 ghcOptStaticLib = toFlag True,
950 ghcOptInputFiles = toNubListR staticObjectFiles,
951 ghcOptOutputFile = toFlag staticLibFilePath,
952 ghcOptExtra = hcStaticOptions GHC libBi,
953 ghcOptHideAllPackages = toFlag True,
954 ghcOptNoAutoLinkPackages = toFlag True,
955 ghcOptPackageDBs = withPackageDB lbi,
956 ghcOptThisUnitId = case clbi of
957 LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
958 -> toFlag pk
959 _ -> mempty,
960 ghcOptThisComponentId = case clbi of
961 LibComponentLocalBuildInfo
962 { componentInstantiatedWith = insts } ->
963 if null insts
964 then mempty
965 else toFlag (componentComponentId clbi)
966 _ -> mempty,
967 ghcOptInstantiatedWith = case clbi of
968 LibComponentLocalBuildInfo
969 { componentInstantiatedWith = insts }
970 -> insts
971 _ -> [],
972 ghcOptPackages = toNubListR $
973 Internal.mkGhcOptPackages clbi ,
974 ghcOptLinkLibs = extraLibs libBi,
975 ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
976 }
977
978 info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
979
980 whenVanillaLib False $ do
981 Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
982 whenGHCiLib $ do
983 (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
984 Ld.combineObjectFiles verbosity lbi ldProg
985 ghciLibFilePath staticObjectFiles
986
987 whenProfLib $ do
988 Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
989 whenGHCiLib $ do
990 (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
991 Ld.combineObjectFiles verbosity lbi ldProg
992 ghciProfLibFilePath profObjectFiles
993
994 whenSharedLib False $
995 runGhcProg ghcSharedLinkArgs
996
997 whenStaticLib False $
998 runGhcProg ghcStaticLinkArgs
999
1000 -- | Start a REPL without loading any source files.
1001 startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
1002 -> PackageDBStack -> IO ()
1003 startInterpreter verbosity progdb comp platform packageDBs = do
1004 let replOpts = mempty {
1005 ghcOptMode = toFlag GhcModeInteractive,
1006 ghcOptPackageDBs = packageDBs
1007 }
1008 checkPackageDbStack verbosity comp packageDBs
1009 (ghcProg, _) <- requireProgram verbosity ghcProgram progdb
1010 runGHC verbosity ghcProg comp platform replOpts
1011
1012 -- -----------------------------------------------------------------------------
1013 -- Building an executable or foreign library
1014
1015 -- | Build a foreign library
1016 buildFLib
1017 :: Verbosity -> Cabal.Flag (Maybe Int)
1018 -> PackageDescription -> LocalBuildInfo
1019 -> ForeignLib -> ComponentLocalBuildInfo -> IO ()
1020 buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
1021
1022 replFLib
1023 :: ReplOptions -> Verbosity
1024 -> Cabal.Flag (Maybe Int) -> PackageDescription
1025 -> LocalBuildInfo -> ForeignLib
1026 -> ComponentLocalBuildInfo -> IO ()
1027 replFLib replFlags v njobs pkg lbi =
1028 gbuild v njobs pkg lbi . GReplFLib replFlags
1029
1030 -- | Build an executable with GHC.
1031 --
1032 buildExe
1033 :: Verbosity -> Cabal.Flag (Maybe Int)
1034 -> PackageDescription -> LocalBuildInfo
1035 -> Executable -> ComponentLocalBuildInfo -> IO ()
1036 buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
1037
1038 replExe
1039 :: ReplOptions -> Verbosity
1040 -> Cabal.Flag (Maybe Int) -> PackageDescription
1041 -> LocalBuildInfo -> Executable
1042 -> ComponentLocalBuildInfo -> IO ()
1043 replExe replFlags v njobs pkg lbi =
1044 gbuild v njobs pkg lbi . GReplExe replFlags
1045
1046 -- | Building an executable, starting the REPL, and building foreign
1047 -- libraries are all very similar and implemented in 'gbuild'. The
1048 -- 'GBuildMode' distinguishes between the various kinds of operation.
1049 data GBuildMode =
1050 GBuildExe Executable
1051 | GReplExe ReplOptions Executable
1052 | GBuildFLib ForeignLib
1053 | GReplFLib ReplOptions ForeignLib
1054
1055 gbuildInfo :: GBuildMode -> BuildInfo
1056 gbuildInfo (GBuildExe exe) = buildInfo exe
1057 gbuildInfo (GReplExe _ exe) = buildInfo exe
1058 gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib
1059 gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib
1060
1061 gbuildName :: GBuildMode -> String
1062 gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe
1063 gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe
1064 gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib
1065 gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib
1066
1067 gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
1068 gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe
1069 gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe
1070 gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib
1071 gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib
1072
1073 exeTargetName :: Platform -> Executable -> String
1074 exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform
1075
1076 -- | Target name for a foreign library (the actual file name)
1077 --
1078 -- We do not use mkLibName and co here because the naming for foreign libraries
1079 -- is slightly different (we don't use "_p" or compiler version suffices, and we
1080 -- don't want the "lib" prefix on Windows).
1081 --
1082 -- TODO: We do use `dllExtension` and co here, but really that's wrong: they
1083 -- use the OS used to build cabal to determine which extension to use, rather
1084 -- than the target OS (but this is wrong elsewhere in Cabal as well).
1085 flibTargetName :: LocalBuildInfo -> ForeignLib -> String
1086 flibTargetName lbi flib =
1087 case (os, foreignLibType flib) of
1088 (Windows, ForeignLibNativeShared) -> nm <.> "dll"
1089 (Windows, ForeignLibNativeStatic) -> nm <.> "lib"
1090 (Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
1091 (_other, ForeignLibNativeShared) ->
1092 "lib" ++ nm <.> dllExtension (hostPlatform lbi)
1093 (_other, ForeignLibNativeStatic) ->
1094 "lib" ++ nm <.> staticLibExtension (hostPlatform lbi)
1095 (_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
1096 where
1097 nm :: String
1098 nm = unUnqualComponentName $ foreignLibName flib
1099
1100 os :: OS
1101 os = let (Platform _ os') = hostPlatform lbi
1102 in os'
1103
1104 -- If a foreign lib foo has lib-version-info 5:1:2 or
1105 -- lib-version-linux 3.2.1, it should be built as libfoo.so.3.2.1
1106 -- Libtool's version-info data is translated into library versions in a
1107 -- nontrivial way: so refer to libtool documentation.
1108 versionedExt :: String
1109 versionedExt =
1110 let nums = foreignLibVersion flib os
1111 in foldl (<.>) "so" (map show nums)
1112
1113 -- | Name for the library when building.
1114 --
1115 -- If the `lib-version-info` field or the `lib-version-linux` field of
1116 -- a foreign library target is set, we need to incorporate that
1117 -- version into the SONAME field.
1118 --
1119 -- If a foreign library foo has lib-version-info 5:1:2, it should be
1120 -- built as libfoo.so.3.2.1. We want it to get soname libfoo.so.3.
1121 -- However, GHC does not allow overriding soname by setting linker
1122 -- options, as it sets a soname of its own (namely the output
1123 -- filename), after the user-supplied linker options. Hence, we have
1124 -- to compile the library with the soname as its filename. We rename
1125 -- the compiled binary afterwards.
1126 --
1127 -- This method allows to adjust the name of the library at build time
1128 -- such that the correct soname can be set.
1129 flibBuildName :: LocalBuildInfo -> ForeignLib -> String
1130 flibBuildName lbi flib
1131 -- On linux, if a foreign-library has version data, the first digit is used
1132 -- to produce the SONAME.
1133 | (os, foreignLibType flib) ==
1134 (Linux, ForeignLibNativeShared)
1135 = let nums = foreignLibVersion flib os
1136 in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
1137 | otherwise = flibTargetName lbi flib
1138 where
1139 os :: OS
1140 os = let (Platform _ os') = hostPlatform lbi
1141 in os'
1142
1143 nm :: String
1144 nm = unUnqualComponentName $ foreignLibName flib
1145
1146 gbuildIsRepl :: GBuildMode -> Bool
1147 gbuildIsRepl (GBuildExe _) = False
1148 gbuildIsRepl (GReplExe _ _) = True
1149 gbuildIsRepl (GBuildFLib _) = False
1150 gbuildIsRepl (GReplFLib _ _) = True
1151
1152 gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
1153 gbuildNeedDynamic lbi bm =
1154 case bm of
1155 GBuildExe _ -> withDynExe lbi
1156 GReplExe _ _ -> withDynExe lbi
1157 GBuildFLib flib -> withDynFLib flib
1158 GReplFLib _ flib -> withDynFLib flib
1159 where
1160 withDynFLib flib =
1161 case foreignLibType flib of
1162 ForeignLibNativeShared ->
1163 ForeignLibStandalone `notElem` foreignLibOptions flib
1164 ForeignLibNativeStatic ->
1165 False
1166 ForeignLibTypeUnknown ->
1167 cabalBug "unknown foreign lib type"
1168
1169 gbuildModDefFiles :: GBuildMode -> [FilePath]
1170 gbuildModDefFiles (GBuildExe _) = []
1171 gbuildModDefFiles (GReplExe _ _) = []
1172 gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
1173 gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib
1174
1175 -- | "Main" module name when overridden by @ghc-options: -main-is ...@
1176 -- or 'Nothing' if no @-main-is@ flag could be found.
1177 --
1178 -- In case of 'Nothing', 'Distribution.ModuleName.main' can be assumed.
1179 exeMainModuleName :: Executable -> Maybe ModuleName
1180 exeMainModuleName Executable{buildInfo = bnfo} =
1181 -- GHC honors the last occurrence of a module name updated via -main-is
1182 --
1183 -- Moreover, -main-is when parsed left-to-right can update either
1184 -- the "Main" module name, or the "main" function name, or both,
1185 -- see also 'decodeMainIsArg'.
1186 msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
1187 where
1188 ghcopts = hcOptions GHC bnfo
1189
1190 findIsMainArgs [] = []
1191 findIsMainArgs ("-main-is":arg:rest) = arg : findIsMainArgs rest
1192 findIsMainArgs (_:rest) = findIsMainArgs rest
1193
1194 -- | Decode argument to '-main-is'
1195 --
1196 -- Returns 'Nothing' if argument set only the function name.
1197 --
1198 -- This code has been stolen/refactored from GHC's DynFlags.setMainIs
1199 -- function. The logic here is deliberately imperfect as it is
1200 -- intended to be bug-compatible with GHC's parser. See discussion in
1201 -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753.
1202 decodeMainIsArg :: String -> Maybe ModuleName
1203 decodeMainIsArg arg
1204 | headOf main_fn isLower
1205 -- The arg looked like "Foo.Bar.baz"
1206 = Just (ModuleName.fromString main_mod)
1207 | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar"
1208 = Just (ModuleName.fromString arg)
1209 | otherwise -- The arg looked like "baz"
1210 = Nothing
1211 where
1212 headOf :: String -> (Char -> Bool) -> Bool
1213 headOf str pred' = any pred' (safeHead str)
1214
1215 (main_mod, main_fn) = splitLongestPrefix arg (== '.')
1216
1217 splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
1218 splitLongestPrefix str pred'
1219 | null r_pre = (str, [])
1220 | otherwise = (reverse (safeTail r_pre), reverse r_suf)
1221 -- 'safeTail' drops the char satisfying 'pred'
1222 where (r_suf, r_pre) = break pred' (reverse str)
1223
1224 -- | A collection of:
1225 -- * C input files
1226 -- * C++ input files
1227 -- * GHC input files
1228 -- * GHC input modules
1229 --
1230 -- Used to correctly build and link sources.
1231 data BuildSources = BuildSources {
1232 cSourcesFiles :: [FilePath],
1233 cxxSourceFiles :: [FilePath],
1234 inputSourceFiles :: [FilePath],
1235 inputSourceModules :: [ModuleName]
1236 }
1237
1238 -- | Locate and return the 'BuildSources' required to build and link.
1239 gbuildSources :: Verbosity
1240 -> PackageId
1241 -> CabalSpecVersion
1242 -> FilePath
1243 -> GBuildMode
1244 -> IO BuildSources
1245 gbuildSources verbosity pkgId specVer tmpDir bm =
1246 case bm of
1247 GBuildExe exe -> exeSources exe
1248 GReplExe _ exe -> exeSources exe
1249 GBuildFLib flib -> return $ flibSources flib
1250 GReplFLib _ flib -> return $ flibSources flib
1251 where
1252 exeSources :: Executable -> IO BuildSources
1253 exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
1254 main <- findFileEx verbosity (tmpDir : map getSymbolicPath (hsSourceDirs bnfo)) modPath
1255 let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
1256 otherModNames = exeModules exe
1257
1258 -- Scripts have fakePackageId and are always Haskell but can have any extension.
1259 if isHaskell main || pkgId == fakePackageId
1260 then
1261 if specVer < CabalSpecV2_0 && (mainModName `elem` otherModNames)
1262 then do
1263 -- The cabal manual clearly states that `other-modules` is
1264 -- intended for non-main modules. However, there's at least one
1265 -- important package on Hackage (happy-1.19.5) which
1266 -- violates this. We workaround this here so that we don't
1267 -- invoke GHC with e.g. 'ghc --make Main src/Main.hs' which
1268 -- would result in GHC complaining about duplicate Main
1269 -- modules.
1270 --
1271 -- Finally, we only enable this workaround for
1272 -- specVersion < 2, as 'cabal-version:>=2.0' cabal files
1273 -- have no excuse anymore to keep doing it wrong... ;-)
1274 warn verbosity $ "Enabling workaround for Main module '"
1275 ++ prettyShow mainModName
1276 ++ "' listed in 'other-modules' illegally!"
1277
1278 return BuildSources {
1279 cSourcesFiles = cSources bnfo,
1280 cxxSourceFiles = cxxSources bnfo,
1281 inputSourceFiles = [main],
1282 inputSourceModules = filter (/= mainModName) $
1283 exeModules exe
1284 }
1285
1286 else return BuildSources {
1287 cSourcesFiles = cSources bnfo,
1288 cxxSourceFiles = cxxSources bnfo,
1289 inputSourceFiles = [main],
1290 inputSourceModules = exeModules exe
1291 }
1292 else let (csf, cxxsf)
1293 | isCxx main = ( cSources bnfo, main : cxxSources bnfo)
1294 -- if main is not a Haskell source
1295 -- and main is not a C++ source
1296 -- then we assume that it is a C source
1297 | otherwise = (main : cSources bnfo, cxxSources bnfo)
1298
1299 in return BuildSources {
1300 cSourcesFiles = csf,
1301 cxxSourceFiles = cxxsf,
1302 inputSourceFiles = [],
1303 inputSourceModules = exeModules exe
1304 }
1305
1306 flibSources :: ForeignLib -> BuildSources
1307 flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} =
1308 BuildSources {
1309 cSourcesFiles = cSources bnfo,
1310 cxxSourceFiles = cxxSources bnfo,
1311 inputSourceFiles = [],
1312 inputSourceModules = foreignLibModules flib
1313 }
1314
1315 isCxx :: FilePath -> Bool
1316 isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
1317
1318 -- | FilePath has a Haskell extension: .hs or .lhs
1319 isHaskell :: FilePath -> Bool
1320 isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
1321
1322 replNoLoad :: Ord a => ReplOptions -> NubListR a -> NubListR a
1323 replNoLoad replFlags l
1324 | replOptionsNoLoad replFlags == Flag True = mempty
1325 | otherwise = l
1326
1327 -- | Generic build function. See comment for 'GBuildMode'.
1328 gbuild :: Verbosity -> Cabal.Flag (Maybe Int)
1329 -> PackageDescription -> LocalBuildInfo
1330 -> GBuildMode -> ComponentLocalBuildInfo -> IO ()
1331 gbuild verbosity numJobs pkg_descr lbi bm clbi = do
1332 (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
1333 let replFlags = case bm of
1334 GReplExe flags _ -> flags
1335 GReplFLib flags _ -> flags
1336 GBuildExe{} -> mempty
1337 GBuildFLib{} -> mempty
1338 comp = compiler lbi
1339 platform = hostPlatform lbi
1340 implInfo = getImplInfo comp
1341 runGhcProg = runGHC verbosity ghcProg comp platform
1342
1343 let bnfo = gbuildInfo bm
1344
1345 -- the name that GHC really uses (e.g., with .exe on Windows for executables)
1346 let targetName = gbuildTargetName lbi bm
1347 let targetDir = buildDir lbi </> (gbuildName bm)
1348 let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
1349 createDirectoryIfMissingVerbose verbosity True targetDir
1350 createDirectoryIfMissingVerbose verbosity True tmpDir
1351
1352 -- TODO: do we need to put hs-boot files into place for mutually recursive
1353 -- modules? FIX: what about exeName.hi-boot?
1354
1355 -- Determine if program coverage should be enabled and if so, what
1356 -- '-hpcdir' should be.
1357 let isCoverageEnabled = exeCoverage lbi
1358 distPref = fromFlag $ configDistPref $ configFlags lbi
1359 hpcdir way
1360 | gbuildIsRepl bm = mempty -- HPC is not supported in ghci
1361 | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
1362 | otherwise = mempty
1363
1364 rpaths <- getRPaths lbi clbi
1365 buildSources <- gbuildSources verbosity (package pkg_descr) (specVersion pkg_descr) tmpDir bm
1366
1367 -- ensure extra lib dirs exist before passing to ghc
1368 cleanedExtraLibDirs <- filterM doesDirectoryExist (extraLibDirs bnfo)
1369 cleanedExtraLibDirsStatic <- filterM doesDirectoryExist (extraLibDirsStatic bnfo)
1370
1371
1372 let cSrcs = cSourcesFiles buildSources
1373 cxxSrcs = cxxSourceFiles buildSources
1374 inputFiles = inputSourceFiles buildSources
1375 inputModules = inputSourceModules buildSources
1376 isGhcDynamic = isDynamic comp
1377 dynamicTooSupported = supportsDynamicToo comp
1378 cLikeObjs = map (`replaceExtension` objExtension) cSrcs
1379 cxxObjs = map (`replaceExtension` objExtension) cxxSrcs
1380 needDynamic = gbuildNeedDynamic lbi bm
1381 needProfiling = withProfExe lbi
1382
1383 -- build executables
1384 baseOpts = (componentGhcOptions verbosity lbi bnfo clbi tmpDir)
1385 `mappend` mempty {
1386 ghcOptMode = toFlag GhcModeMake,
1387 ghcOptInputFiles = toNubListR $ if package pkg_descr == fakePackageId
1388 then filter isHaskell inputFiles
1389 else inputFiles,
1390 ghcOptInputScripts = toNubListR $ if package pkg_descr == fakePackageId
1391 then filter (not . isHaskell) inputFiles
1392 else [],
1393 ghcOptInputModules = toNubListR inputModules
1394 }
1395 staticOpts = baseOpts `mappend` mempty {
1396 ghcOptDynLinkMode = toFlag GhcStaticOnly,
1397 ghcOptHPCDir = hpcdir Hpc.Vanilla
1398 }
1399 profOpts = baseOpts `mappend` mempty {
1400 ghcOptProfilingMode = toFlag True,
1401 ghcOptProfilingAuto = Internal.profDetailLevelFlag False
1402 (withProfExeDetail lbi),
1403 ghcOptHiSuffix = toFlag "p_hi",
1404 ghcOptObjSuffix = toFlag "p_o",
1405 ghcOptExtra = hcProfOptions GHC bnfo,
1406 ghcOptHPCDir = hpcdir Hpc.Prof
1407 }
1408 dynOpts = baseOpts `mappend` mempty {
1409 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
1410 -- TODO: Does it hurt to set -fPIC for executables?
1411 ghcOptFPic = toFlag True,
1412 ghcOptHiSuffix = toFlag "dyn_hi",
1413 ghcOptObjSuffix = toFlag "dyn_o",
1414 ghcOptExtra = hcSharedOptions GHC bnfo,
1415 ghcOptHPCDir = hpcdir Hpc.Dyn
1416 }
1417 dynTooOpts = staticOpts `mappend` mempty {
1418 ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
1419 ghcOptDynHiSuffix = toFlag "dyn_hi",
1420 ghcOptDynObjSuffix = toFlag "dyn_o",
1421 ghcOptHPCDir = hpcdir Hpc.Dyn
1422 }
1423 linkerOpts = mempty {
1424 ghcOptLinkOptions = PD.ldOptions bnfo
1425 ++ [ "-static"
1426 | withFullyStaticExe lbi ]
1427 -- Pass extra `ld-options` given
1428 -- through to GHC's linker.
1429 ++ maybe [] programOverrideArgs
1430 (lookupProgram ldProgram (withPrograms lbi)),
1431 ghcOptLinkLibs = if withFullyStaticExe lbi
1432 then extraLibsStatic bnfo
1433 else extraLibs bnfo,
1434 ghcOptLinkLibPath = toNubListR $
1435 if withFullyStaticExe lbi
1436 then cleanedExtraLibDirsStatic
1437 else cleanedExtraLibDirs,
1438 ghcOptLinkFrameworks = toNubListR $
1439 PD.frameworks bnfo,
1440 ghcOptLinkFrameworkDirs = toNubListR $
1441 PD.extraFrameworkDirs bnfo,
1442 ghcOptInputFiles = toNubListR
1443 [tmpDir </> x | x <- cLikeObjs ++ cxxObjs]
1444 }
1445 dynLinkerOpts = mempty {
1446 ghcOptRPaths = rpaths,
1447 ghcOptInputFiles = toNubListR
1448 [tmpDir </> x | x <- cLikeObjs ++ cxxObjs]
1449 }
1450 replOpts = baseOpts {
1451 ghcOptExtra = Internal.filterGhciFlags
1452 (ghcOptExtra baseOpts)
1453 <> replOptionsFlags replFlags,
1454 ghcOptInputModules = replNoLoad replFlags (ghcOptInputModules baseOpts),
1455 ghcOptInputFiles = replNoLoad replFlags (ghcOptInputFiles baseOpts)
1456 }
1457 -- For a normal compile we do separate invocations of ghc for
1458 -- compiling as for linking. But for repl we have to do just
1459 -- the one invocation, so that one has to include all the
1460 -- linker stuff too, like -l flags and any .o files from C
1461 -- files etc.
1462 `mappend` linkerOpts
1463 `mappend` mempty {
1464 ghcOptMode = toFlag GhcModeInteractive,
1465 ghcOptOptimisation = toFlag GhcNoOptimisation
1466 }
1467 commonOpts | needProfiling = profOpts
1468 | needDynamic = dynOpts
1469 | otherwise = staticOpts
1470 compileOpts | useDynToo = dynTooOpts
1471 | otherwise = commonOpts
1472 withStaticExe = not needProfiling && not needDynamic
1473
1474 -- For building exe's that use TH with -prof or -dynamic we actually have
1475 -- to build twice, once without -prof/-dynamic and then again with
1476 -- -prof/-dynamic. This is because the code that TH needs to run at
1477 -- compile time needs to be the vanilla ABI so it can be loaded up and run
1478 -- by the compiler.
1479 -- With dynamic-by-default GHC the TH object files loaded at compile-time
1480 -- need to be .dyn_o instead of .o.
1481 doingTH = usesTemplateHaskellOrQQ bnfo
1482 -- Should we use -dynamic-too instead of compiling twice?
1483 useDynToo = dynamicTooSupported && isGhcDynamic
1484 && doingTH && withStaticExe
1485 && null (hcSharedOptions GHC bnfo)
1486 compileTHOpts | isGhcDynamic = dynOpts
1487 | otherwise = staticOpts
1488 compileForTH
1489 | gbuildIsRepl bm = False
1490 | useDynToo = False
1491 | isGhcDynamic = doingTH && (needProfiling || withStaticExe)
1492 | otherwise = doingTH && (needProfiling || needDynamic)
1493
1494 -- Build static/dynamic object files for TH, if needed.
1495 when compileForTH $
1496 runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
1497 , ghcOptNumJobs = numJobs }
1498
1499 -- Do not try to build anything if there are no input files.
1500 -- This can happen if the cabal file ends up with only cSrcs
1501 -- but no Haskell modules.
1502 unless ((null inputFiles && null inputModules)
1503 || gbuildIsRepl bm) $
1504 runGhcProg compileOpts { ghcOptNoLink = toFlag True
1505 , ghcOptNumJobs = numJobs }
1506
1507 -- build any C++ sources
1508 unless (null cxxSrcs) $ do
1509 info verbosity "Building C++ Sources..."
1510 sequence_
1511 [ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo
1512 lbi bnfo clbi tmpDir filename
1513 vanillaCxxOpts = if isGhcDynamic
1514 -- Dynamic GHC requires C++ sources to be built
1515 -- with -fPIC for REPL to work. See #2207.
1516 then baseCxxOpts { ghcOptFPic = toFlag True }
1517 else baseCxxOpts
1518 profCxxOpts = vanillaCxxOpts `mappend` mempty {
1519 ghcOptProfilingMode = toFlag True
1520 }
1521 sharedCxxOpts = vanillaCxxOpts `mappend` mempty {
1522 ghcOptFPic = toFlag True,
1523 ghcOptDynLinkMode = toFlag GhcDynamicOnly
1524 }
1525 opts | needProfiling = profCxxOpts
1526 | needDynamic = sharedCxxOpts
1527 | otherwise = vanillaCxxOpts
1528 -- TODO: Placing all Haskell, C, & C++ objects in a single directory
1529 -- Has the potential for file collisions. In general we would
1530 -- consider this a user error. However, we should strive to
1531 -- add a warning if this occurs.
1532 odir = fromFlag (ghcOptObjDir opts)
1533 createDirectoryIfMissingVerbose verbosity True odir
1534 needsRecomp <- checkNeedsRecompilation filename opts
1535 when needsRecomp $
1536 runGhcProg opts
1537 | filename <- cxxSrcs ]
1538
1539 -- build any C sources
1540 let (cSrcs', others) = partition (\filepath -> ".c"`isSuffixOf` filepath) cSrcs
1541 unless (null cSrcs') $ do
1542 info verbosity "Building C Sources..."
1543 unless (null others) $ do
1544 let files = intercalate ", " others
1545 let currentComponentName = gbuildName bm
1546 warn verbosity $ unlines
1547 [ "The following files listed in " <> currentComponentName <> "'s c-sources will not be used: " <> files <> "."
1548 , "Header files should be in the 'include' or 'install-include' stanza."
1549 , "See https://cabal.readthedocs.io/en/3.10/cabal-package.html#pkg-field-includes"
1550 ]
1551 forM_ cSrcs' $ \filename -> do
1552 let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
1553 lbi bnfo clbi tmpDir filename
1554 let vanillaCcOpts = if isGhcDynamic
1555 -- Dynamic GHC requires C sources to be built
1556 -- with -fPIC for REPL to work. See #2207.
1557 then baseCcOpts { ghcOptFPic = toFlag True }
1558 else baseCcOpts
1559 let profCcOpts = vanillaCcOpts `mappend` mempty {
1560 ghcOptProfilingMode = toFlag True
1561 }
1562 let sharedCcOpts = vanillaCcOpts `mappend` mempty {
1563 ghcOptFPic = toFlag True,
1564 ghcOptDynLinkMode = toFlag GhcDynamicOnly
1565 }
1566 let opts | needProfiling = profCcOpts
1567 | needDynamic = sharedCcOpts
1568 | otherwise = vanillaCcOpts
1569 let odir = fromFlag (ghcOptObjDir opts)
1570 createDirectoryIfMissingVerbose verbosity True odir
1571 needsRecomp <- checkNeedsRecompilation filename opts
1572 when needsRecomp $
1573 runGhcProg opts
1574
1575 -- TODO: problem here is we need the .c files built first, so we can load them
1576 -- with ghci, but .c files can depend on .h files generated by ghc by ffi
1577 -- exports.
1578 case bm of
1579 GReplExe _ _ -> runGhcProg replOpts
1580 GReplFLib _ _ -> runGhcProg replOpts
1581 GBuildExe _ -> do
1582 let linkOpts = commonOpts
1583 `mappend` linkerOpts
1584 `mappend` mempty {
1585 ghcOptLinkNoHsMain = toFlag (null inputFiles)
1586 }
1587 `mappend` (if withDynExe lbi then dynLinkerOpts else mempty)
1588
1589 info verbosity "Linking..."
1590 -- Work around old GHCs not relinking in this
1591 -- situation, see #3294
1592 let target = targetDir </> targetName
1593 when (compilerVersion comp < mkVersion [7,7]) $ do
1594 e <- doesFileExist target
1595 when e (removeFile target)
1596 runGhcProg linkOpts { ghcOptOutputFile = toFlag target }
1597 GBuildFLib flib -> do
1598 let -- Instruct GHC to link against libHSrts.
1599 rtsLinkOpts :: GhcOptions
1600 rtsLinkOpts
1601 | supportsFLinkRts =
1602 mempty {
1603 ghcOptLinkRts = toFlag True
1604 }
1605 | otherwise =
1606 mempty {
1607 ghcOptLinkLibs = rtsOptLinkLibs,
1608 ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo
1609 }
1610 where
1611 threaded = hasThreaded (gbuildInfo bm)
1612 supportsFLinkRts = compilerVersion comp >= mkVersion [9,0]
1613 rtsInfo = extractRtsInfo lbi
1614 rtsOptLinkLibs = [
1615 if needDynamic
1616 then if threaded
1617 then dynRtsThreadedLib (rtsDynamicInfo rtsInfo)
1618 else dynRtsVanillaLib (rtsDynamicInfo rtsInfo)
1619 else if threaded
1620 then statRtsThreadedLib (rtsStaticInfo rtsInfo)
1621 else statRtsVanillaLib (rtsStaticInfo rtsInfo)
1622 ]
1623
1624
1625 linkOpts :: GhcOptions
1626 linkOpts = case foreignLibType flib of
1627 ForeignLibNativeShared ->
1628 commonOpts
1629 `mappend` linkerOpts
1630 `mappend` dynLinkerOpts
1631 `mappend` rtsLinkOpts
1632 `mappend` mempty {
1633 ghcOptLinkNoHsMain = toFlag True,
1634 ghcOptShared = toFlag True,
1635 ghcOptFPic = toFlag True,
1636 ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
1637 }
1638 -- See Note [RPATH]
1639 `mappend` ifNeedsRPathWorkaround lbi mempty {
1640 ghcOptLinkOptions = ["-Wl,--no-as-needed"]
1641 , ghcOptLinkLibs = ["ffi"]
1642 }
1643 ForeignLibNativeStatic ->
1644 -- this should be caught by buildFLib
1645 -- (and if we do implement this, we probably don't even want to call
1646 -- ghc here, but rather Ar.createArLibArchive or something)
1647 cabalBug "static libraries not yet implemented"
1648 ForeignLibTypeUnknown ->
1649 cabalBug "unknown foreign lib type"
1650 -- We build under a (potentially) different filename to set a
1651 -- soname on supported platforms. See also the note for
1652 -- @flibBuildName@.
1653 info verbosity "Linking..."
1654 let buildName = flibBuildName lbi flib
1655 runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> buildName) }
1656 renameFile (targetDir </> buildName) (targetDir </> targetName)
1657
1658 {-
1659 Note [RPATH]
1660 ~~~~~~~~~~~~
1661
1662 Suppose that the dynamic library depends on `base`, but not (directly) on
1663 `integer-gmp` (which, however, is a dependency of `base`). We will link the
1664 library as
1665
1666 gcc ... -lHSbase-4.7.0.2-ghc7.8.4 -lHSinteger-gmp-0.5.1.0-ghc7.8.4 ...
1667
1668 However, on systems (like Ubuntu) where the linker gets called with `-as-needed`
1669 by default, the linker will notice that `integer-gmp` isn't actually a direct
1670 dependency and hence omit the link.
1671
1672 Then when we attempt to link a C program against this dynamic library, the
1673 _static_ linker will attempt to verify that all symbols can be resolved. The
1674 dynamic library itself does not require any symbols from `integer-gmp`, but
1675 `base` does. In order to verify that the symbols used by `base` can be
1676 resolved, the static linker needs to be able to _find_ integer-gmp.
1677
1678 Finding the `base` dependency is simple, because the dynamic elf header
1679 (`readelf -d`) for the library that we have created looks something like
1680
1681 (NEEDED) Shared library: [libHSbase-4.7.0.2-ghc7.8.4.so]
1682 (RPATH) Library rpath: [/path/to/base-4.7.0.2:...]
1683
1684 However, when it comes to resolving the dependency on `integer-gmp`, it needs
1685 to look at the dynamic header for `base`. On modern ghc (7.8 and higher) this
1686 looks something like
1687
1688 (NEEDED) Shared library: [libHSinteger-gmp-0.5.1.0-ghc7.8.4.so]
1689 (RPATH) Library rpath: [$ORIGIN/../integer-gmp-0.5.1.0:...]
1690
1691 This specifies the location of `integer-gmp` _in terms of_ the location of base
1692 (using the `$ORIGIN`) variable. But here's the crux: when the static linker
1693 attempts to verify that all symbols can be resolved, [**IT DOES NOT RESOLVE
1694 `$ORIGIN`**](http://stackoverflow.com/questions/6323603/ld-using-rpath-origin-inside-a-shared-library-recursive).
1695 As a consequence, it will not be able to resolve the symbols and report the
1696 missing symbols as errors, _even though the dynamic linker **would** be able to
1697 resolve these symbols_. We can tell the static linker not to report these
1698 errors by using `--unresolved-symbols=ignore-all` and all will be fine when we
1699 run the program ([(indeed, this is what the gold linker
1700 does)](https://sourceware.org/ml/binutils/2013-05/msg00038.html), but it makes
1701 the resulting library more difficult to use.
1702
1703 Instead what we can do is make sure that the generated dynamic library has
1704 explicit top-level dependencies on these libraries. This means that the static
1705 linker knows where to find them, and when we have transitive dependencies on
1706 the same libraries the linker will only load them once, so we avoid needing to
1707 look at the `RPATH` of our dependencies. We can do this by passing
1708 `--no-as-needed` to the linker, so that it doesn't omit any libraries.
1709
1710 Note that on older ghc (7.6 and before) the Haskell libraries don't have an
1711 RPATH set at all, which makes it even more important that we make these
1712 top-level dependencies.
1713
1714 Finally, we have to explicitly link against `libffi` for the same reason. For
1715 newer ghc this _happens_ to be unnecessary on many systems because `libffi` is
1716 a library which is not specific to GHC, and when the static linker verifies
1717 that all symbols can be resolved it will find the `libffi` that is globally
1718 installed (completely independent from ghc). Of course, this may well be the
1719 _wrong_ version of `libffi`, but it's quite possible that symbol resolution
1720 happens to work. This is of course the wrong approach, which is why we link
1721 explicitly against `libffi` so that we will find the _right_ version of
1722 `libffi`.
1723 -}
1724
1725 -- | Do we need the RPATH workaround?
1726 --
1727 -- See Note [RPATH].
1728 ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
1729 ifNeedsRPathWorkaround lbi a =
1730 case hostPlatform lbi of
1731 Platform _ Linux -> a
1732 _otherwise -> mempty
1733
1734 data DynamicRtsInfo = DynamicRtsInfo {
1735 dynRtsVanillaLib :: FilePath
1736 , dynRtsThreadedLib :: FilePath
1737 , dynRtsDebugLib :: FilePath
1738 , dynRtsEventlogLib :: FilePath
1739 , dynRtsThreadedDebugLib :: FilePath
1740 , dynRtsThreadedEventlogLib :: FilePath
1741 }
1742
1743 data StaticRtsInfo = StaticRtsInfo {
1744 statRtsVanillaLib :: FilePath
1745 , statRtsThreadedLib :: FilePath
1746 , statRtsDebugLib :: FilePath
1747 , statRtsEventlogLib :: FilePath
1748 , statRtsThreadedDebugLib :: FilePath
1749 , statRtsThreadedEventlogLib :: FilePath
1750 , statRtsProfilingLib :: FilePath
1751 , statRtsThreadedProfilingLib :: FilePath
1752 }
1753
1754 data RtsInfo = RtsInfo {
1755 rtsDynamicInfo :: DynamicRtsInfo
1756 , rtsStaticInfo :: StaticRtsInfo
1757 , rtsLibPaths :: [FilePath]
1758 }
1759
1760 -- | Extract (and compute) information about the RTS library
1761 --
1762 -- TODO: This hardcodes the name as @HSrts-ghc<version>@. I don't know if we can
1763 -- find this information somewhere. We can lookup the 'hsLibraries' field of
1764 -- 'InstalledPackageInfo' but it will tell us @["HSrts", "Cffi"]@, which
1765 -- doesn't really help.
1766 extractRtsInfo :: LocalBuildInfo -> RtsInfo
1767 extractRtsInfo lbi =
1768 case PackageIndex.lookupPackageName
1769 (installedPkgs lbi) (mkPackageName "rts") of
1770 [(_, [rts])] -> aux rts
1771 _otherwise -> error "No (or multiple) ghc rts package is registered"
1772 where
1773 aux :: InstalledPackageInfo -> RtsInfo
1774 aux rts = RtsInfo {
1775 rtsDynamicInfo = DynamicRtsInfo {
1776 dynRtsVanillaLib = withGhcVersion "HSrts"
1777 , dynRtsThreadedLib = withGhcVersion "HSrts_thr"
1778 , dynRtsDebugLib = withGhcVersion "HSrts_debug"
1779 , dynRtsEventlogLib = withGhcVersion "HSrts_l"
1780 , dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug"
1781 , dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l"
1782 }
1783 , rtsStaticInfo = StaticRtsInfo {
1784 statRtsVanillaLib = "HSrts"
1785 , statRtsThreadedLib = "HSrts_thr"
1786 , statRtsDebugLib = "HSrts_debug"
1787 , statRtsEventlogLib = "HSrts_l"
1788 , statRtsThreadedDebugLib = "HSrts_thr_debug"
1789 , statRtsThreadedEventlogLib = "HSrts_thr_l"
1790 , statRtsProfilingLib = "HSrts_p"
1791 , statRtsThreadedProfilingLib = "HSrts_thr_p"
1792 }
1793 , rtsLibPaths = InstalledPackageInfo.libraryDirs rts
1794 }
1795 withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi))))
1796
1797 -- | Returns True if the modification date of the given source file is newer than
1798 -- the object file we last compiled for it, or if no object file exists yet.
1799 checkNeedsRecompilation :: FilePath -> GhcOptions -> IO Bool
1800 checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
1801 where oname = getObjectFileName filename opts
1802
1803 -- | Finds the object file name of the given source file
1804 getObjectFileName :: FilePath -> GhcOptions -> FilePath
1805 getObjectFileName filename opts = oname
1806 where odir = fromFlag (ghcOptObjDir opts)
1807 oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
1808 oname = odir </> replaceExtension filename oext
1809
1810 -- | Calculate the RPATHs for the component we are building.
1811 --
1812 -- Calculates relative RPATHs when 'relocatable' is set.
1813 getRPaths :: LocalBuildInfo
1814 -> ComponentLocalBuildInfo -- ^ Component we are building
1815 -> IO (NubListR FilePath)
1816 getRPaths lbi clbi | supportRPaths hostOS = do
1817 libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi
1818 let hostPref = case hostOS of
1819 OSX -> "@loader_path"
1820 _ -> "$ORIGIN"
1821 relPath p = if isRelative p then hostPref </> p else p
1822 rpaths = toNubListR (map relPath libraryPaths)
1823 return rpaths
1824 where
1825 (Platform _ hostOS) = hostPlatform lbi
1826 compid = compilerId . compiler $ lbi
1827
1828 -- The list of RPath-supported operating systems below reflects the
1829 -- platforms on which Cabal's RPATH handling is tested. It does _NOT_
1830 -- reflect whether the OS supports RPATH.
1831
1832 -- E.g. when this comment was written, the *BSD operating systems were
1833 -- untested with regards to Cabal RPATH handling, and were hence set to
1834 -- 'False', while those operating systems themselves do support RPATH.
1835 supportRPaths Linux   = True
1836 supportRPaths Windows = False
1837 supportRPaths OSX   = True
1838 supportRPaths FreeBSD   =
1839 case compid of
1840 CompilerId GHC ver | ver >= mkVersion [7,10,2] -> True
1841 _ -> False
1842 supportRPaths OpenBSD   = False
1843 supportRPaths NetBSD   = False
1844 supportRPaths DragonFly = False
1845 supportRPaths Solaris = False
1846 supportRPaths AIX = False
1847 supportRPaths HPUX = False
1848 supportRPaths IRIX = False
1849 supportRPaths HaLVM = False
1850 supportRPaths IOS = False
1851 supportRPaths Android = False
1852 supportRPaths Ghcjs = False
1853 supportRPaths Wasi = False
1854 supportRPaths Hurd = False
1855 supportRPaths (OtherOS _) = False
1856 -- Do _not_ add a default case so that we get a warning here when a new OS
1857 -- is added.
1858
1859 getRPaths _ _ = return mempty
1860
1861 -- | Determine whether the given 'BuildInfo' is intended to link against the
1862 -- threaded RTS. This is used to determine which RTS to link against when
1863 -- building a foreign library with a GHC without support for @-flink-rts@.
1864 hasThreaded :: BuildInfo -> Bool
1865 hasThreaded bi = elem "-threaded" ghc
1866 where
1867 PerCompilerFlavor ghc _ = options bi
1868
1869 -- | Extracts a String representing a hash of the ABI of a built
1870 -- library. It can fail if the library has not yet been built.
1871 --
1872 libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
1873 -> Library -> ComponentLocalBuildInfo -> IO String
1874 libAbiHash verbosity _pkg_descr lbi lib clbi = do
1875 let
1876 libBi = libBuildInfo lib
1877 comp = compiler lbi
1878 platform = hostPlatform lbi
1879 vanillaArgs0 =
1880 (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
1881 `mappend` mempty {
1882 ghcOptMode = toFlag GhcModeAbiHash,
1883 ghcOptInputModules = toNubListR $ exposedModules lib
1884 }
1885 vanillaArgs =
1886 -- Package DBs unnecessary, and break ghc-cabal. See #3633
1887 -- BUT, put at least the global database so that 7.4 doesn't
1888 -- break.
1889 vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB]
1890 , ghcOptPackages = mempty }
1891 sharedArgs = vanillaArgs `mappend` mempty {
1892 ghcOptDynLinkMode = toFlag GhcDynamicOnly,
1893 ghcOptFPic = toFlag True,
1894 ghcOptHiSuffix = toFlag "dyn_hi",
1895 ghcOptObjSuffix = toFlag "dyn_o",
1896 ghcOptExtra = hcSharedOptions GHC libBi
1897 }
1898 profArgs = vanillaArgs `mappend` mempty {
1899 ghcOptProfilingMode = toFlag True,
1900 ghcOptProfilingAuto = Internal.profDetailLevelFlag True
1901 (withProfLibDetail lbi),
1902 ghcOptHiSuffix = toFlag "p_hi",
1903 ghcOptObjSuffix = toFlag "p_o",
1904 ghcOptExtra = hcProfOptions GHC libBi
1905 }
1906 ghcArgs
1907 | withVanillaLib lbi = vanillaArgs
1908 | withSharedLib lbi = sharedArgs
1909 | withProfLib lbi = profArgs
1910 | otherwise = error "libAbiHash: Can't find an enabled library way"
1911
1912 (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
1913 hash <- getProgramInvocationOutput verbosity
1914 (ghcInvocation ghcProg comp platform ghcArgs)
1915 return (takeWhile (not . isSpace) hash)
1916
1917 componentGhcOptions :: Verbosity -> LocalBuildInfo
1918 -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
1919 -> GhcOptions
1920 componentGhcOptions verbosity lbi =
1921 Internal.componentGhcOptions verbosity implInfo lbi
1922 where
1923 comp = compiler lbi
1924 implInfo = getImplInfo comp
1925
1926 componentCcGhcOptions :: Verbosity -> LocalBuildInfo
1927 -> BuildInfo -> ComponentLocalBuildInfo
1928 -> FilePath -> FilePath
1929 -> GhcOptions
1930 componentCcGhcOptions verbosity lbi =
1931 Internal.componentCcGhcOptions verbosity implInfo lbi
1932 where
1933 comp = compiler lbi
1934 implInfo = getImplInfo comp
1935
1936 -- -----------------------------------------------------------------------------
1937 -- Installing
1938
1939 -- |Install executables for GHC.
1940 installExe :: Verbosity
1941 -> LocalBuildInfo
1942 -> FilePath -- ^Where to copy the files to
1943 -> FilePath -- ^Build location
1944 -> (FilePath, FilePath) -- ^Executable (prefix,suffix)
1945 -> PackageDescription
1946 -> Executable
1947 -> IO ()
1948 installExe verbosity lbi binDir buildPref
1949 (progprefix, progsuffix) _pkg exe = do
1950 createDirectoryIfMissingVerbose verbosity True binDir
1951 let exeName' = unUnqualComponentName $ exeName exe
1952 exeFileName = exeTargetName (hostPlatform lbi) exe
1953 fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
1954 installBinary dest = do
1955 installExecutableFile verbosity
1956 (buildPref </> exeName' </> exeFileName)
1957 (dest <.> exeExtension (hostPlatform lbi))
1958 when (stripExes lbi) $
1959 Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi)
1960 (dest <.> exeExtension (hostPlatform lbi))
1961 installBinary (binDir </> fixedExeBaseName)
1962
1963 -- |Install foreign library for GHC.
1964 installFLib :: Verbosity
1965 -> LocalBuildInfo
1966 -> FilePath -- ^install location
1967 -> FilePath -- ^Build location
1968 -> PackageDescription
1969 -> ForeignLib
1970 -> IO ()
1971 installFLib verbosity lbi targetDir builtDir _pkg flib =
1972 install (foreignLibIsShared flib)
1973 builtDir
1974 targetDir
1975 (flibTargetName lbi flib)
1976 where
1977 install isShared srcDir dstDir name = do
1978 let src = srcDir </> name
1979 dst = dstDir </> name
1980 createDirectoryIfMissingVerbose verbosity True targetDir
1981 -- TODO: Should we strip? (stripLibs lbi)
1982 if isShared
1983 then installExecutableFile verbosity src dst
1984 else installOrdinaryFile verbosity src dst
1985 -- Now install appropriate symlinks if library is versioned
1986 let (Platform _ os) = hostPlatform lbi
1987 when (not (null (foreignLibVersion flib os))) $ do
1988 when (os /= Linux) $ die' verbosity
1989 -- It should be impossible to get here.
1990 "Can't install foreign-library symlink on non-Linux OS"
1991 #ifndef mingw32_HOST_OS
1992 -- 'createSymbolicLink file1 file2' creates a symbolic link
1993 -- named 'file2' which points to the file 'file1'.
1994 -- Note that we do want a symlink to 'name' rather than
1995 -- 'dst', because the symlink will be relative to the
1996 -- directory it's created in.
1997 -- Finally, we first create the symlinks in a temporary
1998 -- directory and then rename to simulate 'ln --force'.
1999 withTempDirectory verbosity dstDir nm $ \tmpDir -> do
2000 let link1 = flibBuildName lbi flib
2001 link2 = "lib" ++ nm <.> "so"
2002 createSymbolicLink name (tmpDir </> link1)
2003 renameFile (tmpDir </> link1) (dstDir </> link1)
2004 createSymbolicLink name (tmpDir </> link2)
2005 renameFile (tmpDir </> link2) (dstDir </> link2)
2006 where
2007 nm :: String
2008 nm = unUnqualComponentName $ foreignLibName flib
2009 #endif /* mingw32_HOST_OS */
2010
2011
2012 -- |Install for ghc, .hi, .a and, if --with-ghci given, .o
2013 installLib :: Verbosity
2014 -> LocalBuildInfo
2015 -> FilePath -- ^install location
2016 -> FilePath -- ^install location for dynamic libraries
2017 -> FilePath -- ^Build location
2018 -> PackageDescription
2019 -> Library
2020 -> ComponentLocalBuildInfo
2021 -> IO ()
2022 installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
2023 -- copy .hi files over:
2024 whenVanilla $ copyModuleFiles "hi"
2025 whenProf $ copyModuleFiles "p_hi"
2026 whenShared $ copyModuleFiles "dyn_hi"
2027
2028 -- copy the built library files over:
2029 whenHasCode $ do
2030 whenVanilla $ do
2031 sequence_ [ installOrdinary
2032 builtDir
2033 targetDir
2034 (mkGenericStaticLibName (l ++ f))
2035 | l <- getHSLibraryName
2036 (componentUnitId clbi):(extraBundledLibs (libBuildInfo lib))
2037 , f <- "":extraLibFlavours (libBuildInfo lib)
2038 ]
2039 whenGHCi $ installOrdinary builtDir targetDir ghciLibName
2040 whenProf $ do
2041 installOrdinary builtDir targetDir profileLibName
2042 whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
2043 whenShared $ if
2044 -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.
2045 -- See ghc issue #15837 and Cabal PR #5855.
2046 | specVersion pkg < CabalSpecV3_0 -> do
2047 sequence_ [ installShared builtDir dynlibTargetDir
2048 (mkGenericSharedLibName platform compiler_id (l ++ f))
2049 | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
2050 , f <- "":extraDynLibFlavours (libBuildInfo lib)
2051 ]
2052 | otherwise -> do
2053 sequence_ [ installShared
2054 builtDir
2055 dynlibTargetDir
2056 (mkGenericSharedLibName
2057 platform
2058 compiler_id
2059 (getHSLibraryName uid ++ f))
2060 | f <- "":extraDynLibFlavours (libBuildInfo lib)
2061 ]
2062 sequence_ [ do
2063 files <- getDirectoryContents builtDir
2064 let l' = mkGenericSharedBundledLibName
2065 platform
2066 compiler_id
2067 l
2068 forM_ files $ \ file ->
2069 when (l' `isPrefixOf` file) $ do
2070 isFile <- doesFileExist (builtDir </> file)
2071 when isFile $ do
2072 installShared
2073 builtDir
2074 dynlibTargetDir
2075 file
2076 | l <- extraBundledLibs (libBuildInfo lib)
2077 ]
2078
2079 where
2080 builtDir = componentBuildDir lbi clbi
2081
2082 install isShared srcDir dstDir name = do
2083 let src = srcDir </> name
2084 dst = dstDir </> name
2085
2086 createDirectoryIfMissingVerbose verbosity True dstDir
2087
2088 if isShared
2089 then installExecutableFile verbosity src dst
2090 else installOrdinaryFile verbosity src dst
2091
2092 when (stripLibs lbi) $ Strip.stripLib verbosity
2093 platform (withPrograms lbi) dst
2094
2095 installOrdinary = install False
2096 installShared = install True
2097
2098 copyModuleFiles ext =
2099 findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)
2100 >>= installOrdinaryFiles verbosity targetDir
2101
2102 compiler_id = compilerId (compiler lbi)
2103 platform = hostPlatform lbi
2104 uid = componentUnitId clbi
2105 profileLibName = mkProfLibName uid
2106 ghciLibName = Internal.mkGHCiLibName uid
2107 ghciProfLibName = Internal.mkGHCiProfLibName uid
2108
2109 hasLib = not $ null (allLibModules lib clbi)
2110 && null (cSources (libBuildInfo lib))
2111 && null (cxxSources (libBuildInfo lib))
2112 && null (cmmSources (libBuildInfo lib))
2113 && null (asmSources (libBuildInfo lib))
2114 && (null (jsSources (libBuildInfo lib)) || not hasJsSupport)
2115 hasJsSupport = case hostPlatform lbi of
2116 Platform JavaScript _ -> True
2117 _ -> False
2118 has_code = not (componentIsIndefinite clbi)
2119 whenHasCode = when has_code
2120 whenVanilla = when (hasLib && withVanillaLib lbi)
2121 whenProf = when (hasLib && withProfLib lbi && has_code)
2122 whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
2123 whenShared = when (hasLib && withSharedLib lbi && has_code)
2124
2125 -- -----------------------------------------------------------------------------
2126 -- Registering
2127
2128 hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
2129 hcPkgInfo progdb = HcPkg.HcPkgInfo
2130 { HcPkg.hcPkgProgram = ghcPkgProg
2131 , HcPkg.noPkgDbStack = v < [6,9]
2132 , HcPkg.noVerboseFlag = v < [6,11]
2133 , HcPkg.flagPackageConf = v < [7,5]
2134 , HcPkg.supportsDirDbs = v >= [6,8]
2135 , HcPkg.requiresDirDbs = v >= [7,10]
2136 , HcPkg.nativeMultiInstance = v >= [7,10]
2137 , HcPkg.recacheMultiInstance = v >= [6,12]
2138 , HcPkg.suppressFilesCheck = v >= [6,6]
2139 }
2140 where
2141 v = versionNumbers ver
2142 ghcPkgProg = fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb
2143 ver = fromMaybe (error "GHC.hcPkgInfo: no ghc version") $ programVersion ghcPkgProg
2144
2145 registerPackage
2146 :: Verbosity
2147 -> ProgramDb
2148 -> PackageDBStack
2149 -> InstalledPackageInfo
2150 -> HcPkg.RegisterOptions
2151 -> IO ()
2152 registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
2153 HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
2154 installedPkgInfo registerOptions
2155
2156 pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
2157 pkgRoot verbosity lbi = pkgRoot'
2158 where
2159 pkgRoot' GlobalPackageDB =
2160 let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)
2161 in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
2162 pkgRoot' UserPackageDB = do
2163 appDir <- getGhcAppDir
2164 let ver = compilerVersion (compiler lbi)
2165 subdir = System.Info.arch ++ '-':System.Info.os
2166 ++ '-':prettyShow ver
2167 rootDir = appDir </> subdir
2168 -- We must create the root directory for the user package database if it
2169 -- does not yet exists. Otherwise '${pkgroot}' will resolve to a
2170 -- directory at the time of 'ghc-pkg register', and registration will
2171 -- fail.
2172 createDirectoryIfMissing True rootDir
2173 return rootDir
2174 pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
2175
2176 -- -----------------------------------------------------------------------------
2177 -- Utils
2178
2179 isDynamic :: Compiler -> Bool
2180 isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
2181
2182 supportsDynamicToo :: Compiler -> Bool
2183 supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
2184
2185 withExt :: FilePath -> String -> FilePath
2186 withExt fp ext = fp <.> if takeExtension fp /= ('.':ext) then ext else ""
Common Architecture for Building Applications and Libraries