[Git][ghc/ghc][wip/hadrian-librts-symlinks] Hadrian: Track RTS library symlink targets
David Eichmann
gitlab at gitlab.haskell.org
Tue Jun 11 14:00:31 UTC 2019
David Eichmann pushed to branch wip/hadrian-librts-symlinks at Glasgow Haskell Compiler / GHC
Commits:
fb7051c4 by David Eichmann at 2019-06-11T14:00:14Z
Hadrian: Track RTS library symlink targets
This requires creating RTS library symlinks when registering, outside
of the rule for the registered library file.
- - - - -
5 changed files:
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
Changes:
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -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 ()
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -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 at 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 at 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
@@ -270,4 +248,4 @@ parseLibDynFilename ext = do
-- | Get the package identifier given the package name and version.
pkgId :: String -> [Integer] -> String
-pkgId name version = name ++ "-" ++ intercalate "." (map show version)
\ No newline at end of file
+pkgId name version = name ++ "-" ++ intercalate "." (map show version)
=====================================
hadrian/src/Rules/Program.hs
=====================================
@@ -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/@.
=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -1,7 +1,11 @@
-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 at 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 at 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
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -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'
@@ -175,4 +175,4 @@ replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let
(error $ "Expected RTS library file to start with " ++ oldPrefix)
(newPrefix ++)
(stripPrefix oldPrefix oldFileName)
- in replaceFileName oldFilePath newFileName
\ No newline at end of file
+ in replaceFileName oldFilePath newFileName
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb7051c406623951fe59e99192d81316a7f6fdf2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/fb7051c406623951fe59e99192d81316a7f6fdf2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190611/483c80d6/attachment-0001.html>
More information about the ghc-commits
mailing list