Hadrian: programs need registered ghc-pkg libraries

In Hadrian, building programs (e.g. `ghc` or `haddock`) requires libraries located in the ghc-pkg package database i.e.

    _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHSdeepseq-1.4.4.0-ghc8.9.0.20190430.so

Add the corresponding `need`s for these library files and the subsequent rules.

5 files changed, 121 insertions, 8 deletions

diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index 4ecf1012f4..7c7bb124ff 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -7,8 +7,8 @@ module Context (
 
     -- * Paths
     contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
-    pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,
-    contextPath, getContextPath, libPath, distDir
+    pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile,
+    pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir
     ) where
 
 import Base
@@ -59,11 +59,16 @@ distDir st = do
     hostArch       <- cabalArchString <$> setting BuildArch
     return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
 
+pkgFileName :: Package -> String -> String -> Action FilePath
+pkgFileName package prefix suffix = do
+    pid  <- pkgIdentifier package
+    return $ prefix ++ pid ++ suffix
+
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context@Context {..} prefix suffix = do
     path <- buildPath context
-    pid  <- pkgIdentifier package
-    return $ path -/- prefix ++ pid ++ suffix
+    fileName <- pkgFileName package prefix suffix
+    return $ path -/- fileName
 
 -- | Path to inplace package configuration file of a given 'Context'.
 pkgInplaceConfig :: Context -> Action FilePath
@@ -81,6 +86,20 @@ pkgHaddockFile Context {..} = do
     let name = pkgName package
     return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
 
+-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
+-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
+-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
+pkgRegisteredLibraryFile :: Context -> Action FilePath
+pkgRegisteredLibraryFile context@Context {..} = do
+    libDir    <- libPath context
+    pkgId     <- pkgIdentifier package
+    extension <- libsuf stage way
+    fileName  <- pkgFileName package "libHS" extension
+    distDir   <- distDir stage
+    return $ if Dynamic `wayUnit` way
+        then libDir -/- distDir -/- fileName
+        else libDir -/- distDir -/- pkgId -/- fileName
+
 -- | Path to the library file of a given 'Context', e.g.:
 -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
 pkgLibraryFile :: Context -> Action FilePath
diff --git a/hadrian/src/Hadrian/BuildPath.hs b/hadrian/src/Hadrian/BuildPath.hs
index 962475cb38..6fa4b7f383 100644
--- a/hadrian/src/Hadrian/BuildPath.hs
+++ b/hadrian/src/Hadrian/BuildPath.hs
@@ -35,6 +35,40 @@ parseBuildPath root afterBuild = do
     a <- afterBuild
     return (BuildPath root stage pkgpath a)
 
+-- | A path of the form
+--
+-- > <build root>/stage<N>/lib/<arch>-<os>-ghc-<ghc version>/<something>
+--
+-- where @something@ describes a library or object file or ... to be registerd
+-- for the given package. These are files registered into a ghc-pkg database.
+--
+-- @a@, which represents that @something@, is instantiated with library-related
+-- data types in @Rules.Library@ and with object/interface files related types
+-- in @Rules.Compile@.
+data GhcPkgPath a
+    = GhcPkgPath
+        FilePath -- ^ > <build root>/
+        Stage    -- ^ > stage<N>/
+        FilePath -- ^ > lib/<arch>-<os>-ghc-<ghc version>/
+        a        -- ^ > whatever comes after
+        deriving (Eq, Show)
+
+-- | Parse a registered ghc-pkg path under the given build root.
+parseGhcPkgPath
+    :: FilePath -- ^ build root
+    -> Parsec.Parsec String () a -- ^ what to parse after @build/@
+    -> Parsec.Parsec String () (GhcPkgPath a)
+parseGhcPkgPath root after = do
+    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
+    stage <- parseStage
+    _ <- Parsec.char '/'
+    regPath <- Parsec.string "lib/"
+            <> Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
+    a <- after
+    return (GhcPkgPath root stage regPath a)
+
+
+
 -- To be kept in sync with Stage.hs's stageString function
 -- | Parse @"stageX"@ into a 'Stage'.
 parseStage :: Parsec.Parsec String () Stage
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index f0ec50b020..6340f4f962 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -24,11 +24,27 @@ libraryRules = do
     root -/- "//libHS*-*.so"          %> buildDynamicLibUnix root "so"
     root -/- "//*.a"                  %> buildStaticLib      root
     priority 2 $ do
-        root -/- "//HS*-*.o" %> buildGhciLibO root
+        root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib"
+        root -/- "stage*/lib//libHS*-*.so"    %> registerDynamicLibUnix root "so"
+        root -/- "stage*/lib//*.a"            %> registerStaticLib  root
+        root -/- "//HS*-*.o"   %> buildGhciLibO root
         root -/- "//HS*-*.p_o" %> buildGhciLibO root
 
 -- * 'Action's for building libraries
 
+-- | Register (with ghc-pkg) a static library ('LibA') under the given build
+-- root, whose path is the second argument.
+registerStaticLib :: FilePath -> FilePath -> Action ()
+registerStaticLib root archivePath = do
+    -- Simply need the ghc-pkg database .conf file.
+    GhcPkgPath _ stage _ (LibA name version _)
+        <- parsePath (parseGhcPkgLibA root)
+                    "<.a library (register) path parser>"
+                    archivePath
+    need [ root -/- relativePackageDbPath stage
+                -/- (pkgId name version) ++ ".conf"
+         ]
+
 -- | Build a static library ('LibA') under the given build root, whose path is
 -- the second argument.
 buildStaticLib :: FilePath -> FilePath -> Action ()
@@ -46,6 +62,21 @@ buildStaticLib root archivePath = do
         (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
         archivePath synopsis
 
+-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build
+-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where
+-- the complete path of the registered dynamic library is given as the third
+-- argument.
+registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
+registerDynamicLibUnix root suffix dynlibpath = do
+    -- Simply need the ghc-pkg database .conf file.
+    (GhcPkgPath _ stage _ (LibDyn name version _ _))
+        <- parsePath (parseGhcPkgLibDyn root suffix)
+                            "<dyn register lib parser>"
+                            dynlibpath
+    need [ root -/- relativePackageDbPath stage
+                -/- pkgId name version ++ ".conf"
+         ]
+
 -- | Build a dynamic library ('LibDyn') under the given build root, with the
 -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
 -- path of the archive to build is given as the third argument.
@@ -54,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 pkgLibraryFile deps
+    need =<< mapM pkgRegisteredLibraryFile deps
 
     -- TODO should this be somewhere else?
     -- Custom build step to generate libffi.so* in the rts build directory.
@@ -156,6 +187,16 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
   where
     pkg = library pkgname pkgpath
 
+-- | Parse a path to a registered ghc-pkg static library to be built, making
+-- sure the path starts with the given build root.
+parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA)
+parseGhcPkgLibA root
+    = parseGhcPkgPath root
+        (do -- Skip past pkgId directory.
+            _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
+            parseLibAFilename)
+        Parsec.<?> "ghc-pkg path for a static library"
+
 -- | Parse a path to a static library to be built, making sure the path starts
 -- with the given build root.
 parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
@@ -174,6 +215,12 @@ parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath Lib
 parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
     Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
 
+-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path
+-- starts with the given package database root.
+parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn)
+parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext)
+    Parsec.<?> ("ghc-pkg path for a dynamic library with extension " ++ ext)
+
 -- | Parse the filename of a static library to be built into a 'LibA' value.
 parseLibAFilename :: Parsec.Parsec String () LibA
 parseLibAFilename = do
@@ -202,3 +249,7 @@ parseLibDynFilename ext = do
     _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
     _ <- Parsec.string ("." ++ ext)
     return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
+
+-- | 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
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index 86ac88f1bb..bd4c4e358d 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -89,6 +89,15 @@ buildProgram bin ctx@(Context{..}) rs = do
     -- Haddock has a resource folder
     need =<< haddockDeps stage
 
+  -- Need library dependencies.
+  -- Note pkgLibraryFile gets the path in the build dir e.g.
+  --    _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
+  -- 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
+
   cross <- flag CrossCompiling
   -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
   case (cross, stage) of
diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs
index 553bdbbf9e..b7e3d49b53 100644
--- a/hadrian/src/Rules/Rts.hs
+++ b/hadrian/src/Rules/Rts.hs
@@ -7,10 +7,10 @@ import Settings.Builders.Common
 -- | Dynamic RTS library files need symlinks without the dummy version number.
 -- This is for backwards compatibility (the old make build system omitted the
 -- dummy version number).
--- This rule has priority 2 to override the general rule for generating share
+-- This rule has priority 3 to override the general rule for generating shared
 -- library files (see Rules.Library.libraryRules).
 rtsRules :: Rules ()
-rtsRules = priority 2 $ do
+rtsRules = priority 3 $ do
     root <- buildRootRules
     [ root -/- "//libHSrts_*-ghc*.so",
       root -/- "//libHSrts_*-ghc*.dylib",