Update Cabal to HEAD, IPID renamed to Component ID.

This commit contains a Cabal submodule update which unifies installed
package IDs and package keys under a single notion, a Component ID.
We update GHC to keep follow this unification.  However, this commit
does NOT rename installed package ID to component ID and package key to
unit ID; the plan is to do that in a companion commit.

    - Compiler info now has "Requires unified installed package IDs"

    - 'exposed' is now expected to contain unit keys, not IPIDs.

    - Shadowing is no more.  We now just have a very simple strategy
      to deal with duplicate unit keys in combined package databases:
      if their ABIs are the same, use the latest one; otherwise error.
      Package databases maintain the invariant that there can only
      be one entry of a unit ID.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, bgamari, hvr, goldfire

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1184

GHC Trac Issues: #10714

1 files changed, 14 insertions, 42 deletions

diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 206b676031..71ba847c48 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -229,12 +229,7 @@ doRegister directory distDir ghc ghcpkg topdir
             let installedPkgs' = PackageIndex.fromList instInfos
             let updateComponentConfig (cn, clbi, deps)
                     = (cn, updateComponentLocalBuildInfo clbi, deps)
-                updateComponentLocalBuildInfo clbi
-                    = clbi {
-                          componentPackageDeps =
-                              [ (fixupPackageId instInfos ipid, pid)
-                              | (ipid,pid) <- componentPackageDeps clbi ]
-                      }
+                updateComponentLocalBuildInfo clbi = clbi -- TODO: remove
                 ccs' = map updateComponentConfig (componentsConfigs lbi)
                 lbi' = lbi {
                                componentsConfigs = ccs',
@@ -265,30 +260,6 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts
           htmldir   = toPathTemplate "$docdir"
       }
 
--- The packages are built with the package ID ending in "-inplace", but
--- when they're installed they get the package hash appended. We need to
--- fix up the package deps so that they use the hash package IDs, not
--- the inplace package IDs.
-fixupPackageId :: [Installed.InstalledPackageInfo]
-               -> InstalledPackageId
-               -> InstalledPackageId
-fixupPackageId _ x@(InstalledPackageId ipi)
- | "builtin_" `isPrefixOf` ipi = x
-fixupPackageId ipinfos (InstalledPackageId ipi)
- = case stripPrefix (reverse "-inplace") $ reverse ipi of
-   Nothing ->
-       error ("Installed package ID doesn't end in -inplace: " ++ show ipi)
-   Just x ->
-       let ipi' = reverse ('-' : x)
-           f (ipinfo : ipinfos') = case Installed.installedPackageId ipinfo of
-                                   y@(InstalledPackageId ipinfoid)
-                                    | ipi' `isPrefixOf` ipinfoid ->
-                                       y
-                                   _ ->
-                                       f ipinfos'
-           f [] = error ("Installed package ID not registered: " ++ show ipi)
-       in f ipinfos
-
 -- On Windows we need to split the ghc package into 2 pieces, or the
 -- DLL that it makes contains too many symbols (#5987). There are
 -- therefore 2 libraries, not just the 1 that Cabal assumes.
@@ -316,7 +287,7 @@ generate directory distdir dll0Modules config_args
       -- XXX We shouldn't just configure with the default flags
       -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
       -- aren't going to work when the deps aren't built yet
-      withArgs (["configure", "--distdir", distdir] ++ config_args)
+      withArgs (["configure", "--distdir", distdir, "--ipid", "$pkg-$version"] ++ config_args)
                runDefaultMain
 
       lbi <- getPersistBuildConfig distdir
@@ -342,11 +313,12 @@ generate directory distdir dll0Modules config_args
       -- generate inplace-pkg-config
       withLibLBI pd lbi $ \lib clbi ->
           do cwd <- getCurrentDirectory
-             let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
+             let ipid = ComponentId (display (packageId pd))
              let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
-                                        pd ipid lib lbi clbi
+                                        pd (Installed.AbiHash "") lib lbi clbi
                  final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo {
-                                 Installed.installedPackageId = ipid,
+                                 Installed.installedComponentId = ipid,
+                                 Installed.compatPackageKey = ipid,
                                  Installed.haddockHTMLs = []
                              }
                  content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
@@ -397,24 +369,24 @@ generate directory distdir dll0Modules config_args
           dep_ids  = map snd (externalPackageDeps lbi)
           deps     = map display dep_ids
           dep_direct = map (fromMaybe (error "ghc-cabal: dep_keys failed")
-                           . PackageIndex.lookupInstalledPackageId
+                           . PackageIndex.lookupComponentId
                                             (installedPkgs lbi)
                            . fst)
                        . externalPackageDeps
                        $ lbi
-          dep_ipids = map (display . Installed.installedPackageId) dep_direct
+          dep_ipids = map (display . Installed.installedComponentId) dep_direct
           depLibNames
-            | packageKeySupported comp
-                = map (display . Installed.libraryName) dep_direct
+            | packageKeySupported comp = dep_ipids
             | otherwise = deps
           depNames = map (display . packageName) dep_ids
 
           transitive_dep_ids = map Installed.sourcePackageId dep_pkgs
           transitiveDeps = map display transitive_dep_ids
           transitiveDepLibNames
-            | packageKeySupported comp
-                = map (display . Installed.libraryName) dep_pkgs
+            | packageKeySupported comp = map fixupRtsLibName transitiveDeps
             | otherwise = transitiveDeps
+          fixupRtsLibName "rts-1.0" = "rts"
+          fixupRtsLibName x = x
           transitiveDepNames = map (display . packageName) transitive_dep_ids
 
           libraryDirs = forDeps Installed.libraryDirs
@@ -434,9 +406,9 @@ generate directory distdir dll0Modules config_args
           allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
                 -- TODO: move inside withLibLBI
-                variablePrefix ++ "_PACKAGE_KEY = " ++ display (localPackageKey lbi),
+                variablePrefix ++ "_PACKAGE_KEY = " ++ display (localCompatPackageKey lbi),
                 -- copied from mkComponentsLocalBuildInfo
-                variablePrefix ++ "_LIB_NAME = " ++ display (localLibraryName lbi),
+                variablePrefix ++ "_LIB_NAME = " ++ display (localComponentId lbi),
                 variablePrefix ++ "_MODULES = " ++ unwords mods,
                 variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,