Commit e98d32a6 authored by David Eichmann's avatar David Eichmann 🏋 Committed by Marge Bot

Hadrian: Track RTS library symlink targets

This requires creating RTS library symlinks when registering, outside
of the rule for the registered library file.
parent a657543c
Pipeline #7053 passed with stages
in 307 minutes and 40 seconds
......@@ -16,7 +16,7 @@ module Hadrian.Utilities (
BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
-- * File system operations
copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile,
copyFile, copyFileUntracked, createFileLink, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory,
......@@ -290,17 +290,6 @@ infixl 1 <&>
isGeneratedSource :: FilePath -> Action Bool
isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
-- | Link a file (without tracking the link target). Create the target directory
-- if missing.
createFileLinkUntracked :: FilePath -> FilePath -> Action ()
createFileLinkUntracked linkTarget link = do
let dir = takeDirectory link
liftIO $ IO.createDirectoryIfMissing True dir
putProgressInfo =<< renderCreateFileLink linkTarget link
quietly . liftIO $ do
IO.removeFile link <|> return ()
IO.createFileLink linkTarget link
-- | Link a file tracking the link target. Create the target directory if
-- missing.
createFileLink :: FilePath -> FilePath -> Action ()
......@@ -309,7 +298,12 @@ createFileLink linkTarget link = do
then linkTarget
else takeDirectory link -/- linkTarget
need [source]
createFileLinkUntracked linkTarget link
let dir = takeDirectory link
liftIO $ IO.createDirectoryIfMissing True dir
putProgressInfo =<< renderCreateFileLink linkTarget link
quietly . liftIO $ do
IO.removeFile link <|> return ()
IO.createFileLink linkTarget link
-- | Copy a file tracking the source. Create the target directory if missing.
copyFile :: FilePath -> FilePath -> Action ()
......
......@@ -11,7 +11,7 @@ import Expression hiding (way, package)
import Oracles.ModuleFiles
import Packages
import Rules.Gmp
import Rules.Rts (needRtsLibffiTargets)
import Rules.Register
import Target
import Utilities
......@@ -85,7 +85,7 @@ buildDynamicLibUnix root suffix dynlibpath = do
dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
let context = libDynContext dynlib
deps <- contextDependencies context
need =<< mapM pkgRegisteredLibraryFile deps
registerPackages deps
objs <- libraryObjects context
build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]
......@@ -144,28 +144,6 @@ libraryObjects context@Context{..} = do
need $ noHsObjs ++ hsObjs
return (noHsObjs ++ hsObjs)
-- | Return extra library targets.
extraTargets :: Context -> Action [FilePath]
extraTargets context
| package context == rts = needRtsLibffiTargets (Context.stage context)
| otherwise = return []
-- | Given a library 'Package' this action computes all of its targets. Needing
-- all the targets should build the library such that it is ready to be
-- registered into the package database.
-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
libraryTargets :: Bool -> Context -> Action [FilePath]
libraryTargets includeGhciLib context@Context {..} = do
libFile <- pkgLibraryFile context
ghciLib <- pkgGhciLibraryFile context
ghci <- if includeGhciLib && not (wayUnit Dynamic way)
then interpretInContext context $ getContextData buildGhciLib
else return False
extra <- extraTargets context
return $ [ libFile ]
++ [ ghciLib | ghci ]
++ extra
-- | Coarse-grain 'need': make sure all given libraries are fully built.
needLibrary :: [Context] -> Action ()
needLibrary cs = need =<< concatMapM (libraryTargets True) cs
......
......@@ -15,6 +15,7 @@ import Settings.Default
import Target
import Utilities
import Rules.Library
import Rules.Register
-- | TODO: Drop code duplication
buildProgramRules :: [(Resource, Int)] -> Rules ()
......@@ -96,8 +97,7 @@ buildProgram bin ctx@(Context{..}) rs = do
-- but when building the program, we link against the *ghc-pkg registered* library e.g.
-- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
-- so we use pkgRegisteredLibraryFile instead.
need =<< mapM pkgRegisteredLibraryFile
=<< contextDependencies ctx
registerPackages =<< contextDependencies ctx
cross <- flag CrossCompiling
-- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
......
module Rules.Register (configurePackageRules, registerPackageRules) where
module Rules.Register (
configurePackageRules, registerPackageRules, registerPackages,
libraryTargets
) where
import Base
import Context
import Expression ( getContextData )
import Hadrian.BuildPath
import Hadrian.Expression
import Hadrian.Haskell.Cabal
......@@ -12,7 +16,9 @@ import Rules.Rts
import Settings
import Target
import Utilities
import Rules.Library
import Hadrian.Haskell.Cabal.Type
import qualified Text.Parsec as Parsec
import Distribution.Version (Version)
import qualified Distribution.Parsec as Cabal
......@@ -21,7 +27,6 @@ import qualified Distribution.Types.PackageId as Cabal
import qualified Hadrian.Haskell.Cabal.Parse as Cabal
import qualified System.Directory as IO
import qualified Text.Parsec as Parsec
-- * Configuring
......@@ -63,6 +68,15 @@ parseToBuildSubdirectory root = do
-- * Registering
registerPackages :: [Context] -> Action ()
registerPackages ctxs = do
need =<< mapM pkgRegisteredLibraryFile ctxs
-- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules).
forM_ ctxs $ \ ctx -> when (package ctx == rts) $ do
ways <- interpretInContext ctx (getLibraryWays <> getRtsWays)
needRtsSymLinks (stage ctx) ways
-- | Register a package and initialise the corresponding package database if
-- need be. Note that we only register packages in 'Stage0' and 'Stage1'.
registerPackageRules :: [(Resource, Int)] -> Stage -> Rules ()
......@@ -118,9 +132,6 @@ buildConf _ context@Context {..} conf = do
Cabal.copyPackage context
Cabal.registerPackage context
-- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules).
when (package == rts) (needRtsSymLinks stage ways)
-- The above two steps produce an entry in the package database, with copies
-- of many of the files we have build, e.g. Haskell interface files. We need
-- to record this side effect so that Shake can cache these files too.
......@@ -171,3 +182,25 @@ parseCabalName = fmap f . Cabal.eitherParsec
where
f :: Cabal.PackageId -> (String, Version)
f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id)
-- | Return extra library targets.
extraTargets :: Context -> Action [FilePath]
extraTargets context
| package context == rts = needRtsLibffiTargets (Context.stage context)
| otherwise = return []
-- | Given a library 'Package' this action computes all of its targets. Needing
-- all the targets should build the library such that it is ready to be
-- registered into the package database.
-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
libraryTargets :: Bool -> Context -> Action [FilePath]
libraryTargets includeGhciLib context@Context {..} = do
libFile <- pkgLibraryFile context
ghciLib <- pkgGhciLibraryFile context
ghci <- if includeGhciLib && not (wayUnit Dynamic way)
then interpretInContext context $ getContextData buildGhciLib
else return False
extra <- extraTargets context
return $ [ libFile ]
++ [ ghciLib | ghci ]
++ extra
......@@ -17,7 +17,7 @@ rtsRules = priority 3 $ do
root -/- "//libHSrts_*-ghc*.dylib",
root -/- "//libHSrts-ghc*.so",
root -/- "//libHSrts-ghc*.dylib"]
|%> \ rtsLibFilePath' -> createFileLinkUntracked
|%> \ rtsLibFilePath' -> createFileLink
(addRtsDummyVersion $ takeFileName rtsLibFilePath')
rtsLibFilePath'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment