Linker: reorganize linker related code

Move linker related code into GHC.Linker. Previously it was scattered
into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc.

Add documentation in GHC.Linker

4 files changed, 4 insertions, 122 deletions

diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index 5f038f5d83..36193fce94 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -59,7 +59,7 @@ import GHC.Utils.Misc
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
 
-import GHC.Runtime.Linker.Types
+import GHC.Linker.Types
 
 import Data.IORef       ( IORef, readIORef, atomicModifyIORef' )
 import System.Directory
diff --git a/compiler/GHC/Unit/Home/ModInfo.hs b/compiler/GHC/Unit/Home/ModInfo.hs
index 9732955521..fd97689972 100644
--- a/compiler/GHC/Unit/Home/ModInfo.hs
+++ b/compiler/GHC/Unit/Home/ModInfo.hs
@@ -24,7 +24,7 @@ import GHC.Unit.Module.ModIface
 import GHC.Unit.Module.ModDetails
 import GHC.Unit.Module
 
-import GHC.Runtime.Linker.Types ( Linkable(..) )
+import GHC.Linker.Types ( Linkable(..) )
 
 import GHC.Types.Unique
 import GHC.Types.Unique.DFM
diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs
index 4b75dff099..640c258273 100644
--- a/compiler/GHC/Unit/Module/ModGuts.hs
+++ b/compiler/GHC/Unit/Module/ModGuts.hs
@@ -21,7 +21,7 @@ import GHC.Core         ( CoreProgram, CoreRule )
 import GHC.Core.TyCon
 import GHC.Core.PatSyn
 
-import GHC.Runtime.Linker.Types ( SptEntry(..) )
+import GHC.Linker.Types ( SptEntry(..) )
 
 import GHC.Types.Annotations ( Annotation )
 import GHC.Types.Avail
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 1d770de9f1..74ba55a702 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -41,16 +41,10 @@ module GHC.Unit.State (
 
         -- * Inspecting the set of packages in scope
         getUnitIncludePath,
-        getUnitLibraryPath,
-        getUnitLinkOpts,
         getUnitExtraCcOpts,
-        getUnitFrameworkPath,
-        getUnitFrameworks,
         getPreloadUnitsAnd,
 
-        collectArchives,
-        collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
-        packageHsLibs, getLibs,
+        collectIncludeDirs,
 
         -- * Module hole substitution
         ShHoleSubst,
@@ -1800,124 +1794,12 @@ getUnitIncludePath ctx unit_state home_unit pkgs =
 collectIncludeDirs :: [UnitInfo] -> [FilePath]
 collectIncludeDirs ps = map ST.unpack $ ordNub (filter (not . ST.null) (concatMap unitIncludeDirs ps))
 
--- | Find all the library paths in these and the preload packages
-getUnitLibraryPath :: SDocContext -> UnitState -> HomeUnit -> Ways -> [UnitId] -> IO [String]
-getUnitLibraryPath ctx unit_state home_unit ws pkgs =
-  collectLibraryPaths ws `fmap` getPreloadUnitsAnd ctx unit_state home_unit pkgs
-
-collectLibraryPaths :: Ways -> [UnitInfo] -> [FilePath]
-collectLibraryPaths ws = ordNub . filter notNull
-                           . concatMap (libraryDirsForWay ws)
-
--- | Find all the link options in these and the preload packages,
--- returning (package hs lib options, extra library options, other flags)
-getUnitLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String])
-getUnitLinkOpts dflags pkgs =
-  collectLinkOpts dflags `fmap` getPreloadUnitsAnd
-                                       (initSDocContext dflags defaultUserStyle)
-                                       (unitState dflags)
-                                       (mkHomeUnitFromFlags dflags)
-                                       pkgs
-
-collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
-collectLinkOpts dflags ps =
-    (
-        concatMap (map ("-l" ++) . packageHsLibs dflags) ps,
-        concatMap (map ("-l" ++) . map ST.unpack . unitExtDepLibsSys) ps,
-        concatMap (map ST.unpack . unitLinkerOptions) ps
-    )
-collectArchives :: DynFlags -> UnitInfo -> IO [FilePath]
-collectArchives dflags pc =
-  filterM doesFileExist [ searchPath </> ("lib" ++ lib ++ ".a")
-                        | searchPath <- searchPaths
-                        , lib <- libs ]
-  where searchPaths = ordNub . filter notNull . libraryDirsForWay (ways dflags) $ pc
-        libs        = packageHsLibs dflags pc ++ (map ST.unpack $ unitExtDepLibsSys pc)
-
-getLibs :: DynFlags -> [UnitId] -> IO [(String,String)]
-getLibs dflags pkgs = do
-  ps <- getPreloadUnitsAnd
-            (initSDocContext dflags defaultUserStyle)
-            (unitState dflags)
-            (mkHomeUnitFromFlags dflags)
-            pkgs
-  fmap concat . forM ps $ \p -> do
-    let candidates = [ (l </> f, f) | l <- collectLibraryPaths (ways dflags) [p]
-                                    , f <- (\n -> "lib" ++ n ++ ".a") <$> packageHsLibs dflags p ]
-    filterM (doesFileExist . fst) candidates
-
-packageHsLibs :: DynFlags -> UnitInfo -> [String]
-packageHsLibs dflags p = map (mkDynName . addSuffix . ST.unpack) (unitLibraries p)
-  where
-        ways0 = ways dflags
-
-        ways1 = Set.filter (/= WayDyn) ways0
-        -- the name of a shared library is libHSfoo-ghc<version>.so
-        -- we leave out the _dyn, because it is superfluous
-
-        -- debug and profiled RTSs include support for -eventlog
-        ways2 | WayDebug `Set.member` ways1 || WayProf `Set.member` ways1
-              = Set.filter (/= WayTracing) ways1
-              | otherwise
-              = ways1
-
-        tag     = waysTag (fullWays ways2)
-        rts_tag = waysTag ways2
-
-        mkDynName x
-         | WayDyn `Set.notMember` ways dflags = x
-         | "HS" `isPrefixOf` x                =
-              x ++ '-':programName dflags ++ projectVersion dflags
-           -- For non-Haskell libraries, we use the name "Cfoo". The .a
-           -- file is libCfoo.a, and the .so is libfoo.so. That way the
-           -- linker knows what we mean for the vanilla (-lCfoo) and dyn
-           -- (-lfoo) ways. We therefore need to strip the 'C' off here.
-         | Just x' <- stripPrefix "C" x = x'
-         | otherwise
-            = panic ("Don't understand library name " ++ x)
-
-        -- Add _thr and other rts suffixes to packages named
-        -- `rts` or `rts-1.0`. Why both?  Traditionally the rts
-        -- package is called `rts` only.  However the tooling
-        -- usually expects a package name to have a version.
-        -- As such we will gradually move towards the `rts-1.0`
-        -- package name, at which point the `rts` package name
-        -- will eventually be unused.
-        --
-        -- This change elevates the need to add custom hooks
-        -- and handling specifically for the `rts` package for
-        -- example in ghc-cabal.
-        addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)
-        addSuffix rts@"HSrts-1.0"= rts       ++ (expandTag rts_tag)
-        addSuffix other_lib      = other_lib ++ (expandTag tag)
-
-        expandTag t | null t = ""
-                    | otherwise = '_':t
-
--- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
-libraryDirsForWay :: Ways -> UnitInfo -> [String]
-libraryDirsForWay ws ui
-  | WayDyn `elem` ws = map ST.unpack $ unitLibraryDynDirs ui
-  | otherwise        = map ST.unpack $ unitLibraryDirs ui
-
 -- | Find all the C-compiler options in these and the preload packages
 getUnitExtraCcOpts :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [String]
 getUnitExtraCcOpts ctx unit_state home_unit pkgs = do
   ps <- getPreloadUnitsAnd ctx unit_state home_unit pkgs
   return $ map ST.unpack (concatMap unitCcOptions ps)
 
--- | Find all the package framework paths in these and the preload packages
-getUnitFrameworkPath :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [String]
-getUnitFrameworkPath ctx unit_state home_unit pkgs = do
-  ps <- getPreloadUnitsAnd ctx unit_state home_unit pkgs
-  return $ map ST.unpack (ordNub (filter (not . ST.null) (concatMap unitExtDepFrameworkDirs ps)))
-
--- | Find all the package frameworks in these and the preload packages
-getUnitFrameworks :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [String]
-getUnitFrameworks ctx unit_state home_unit pkgs = do
-  ps <- getPreloadUnitsAnd ctx unit_state home_unit pkgs
-  return $ map ST.unpack (concatMap unitExtDepFrameworks ps)
-
 -- -----------------------------------------------------------------------------
 -- Package Utils