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