Library names, with Cabal submodule update

A library name is a package name, package version, and hash of the
version names of all textual dependencies (i.e. packages which were included.) A library
name is a coarse approximation of installed package IDs, which are suitable for
inclusion in package keys (you don't want to put an IPID in a package key, since
it means the key will change any time the source changes.)

    - We define ShPackageKey, which is the semantic object which
      is hashed into a PackageKey.  You can use 'newPackageKey'
      to hash a ShPackageKey to a PackageKey

    - Given a PackageKey, we can lookup its ShPackageKey with
      'lookupPackageKey'.  The way we can do this is by consulting
      the 'pkgKeyCache', which records a reverse mapping from
      every hash to the ShPackageKey.  This means that if you
      load in PackageKeys from external sources (e.g. interface
      files), you also need to load in a mapping of PackageKeys
      to their ShPackageKeys so we can populate the cache.

    - We define a 'LibraryName' which encapsulates the full
      depenency resolution that Cabal may have selected; this
      is opaque to GHC but can be used to distinguish different
      versions of a package.

    - Definite packages don't have an interesting PackageKey,
      so we rely on Cabal to pass them to us.

    - We can pretty-print package keys while displaying the
      instantiation, but it's not wired up to anything (e.g.
      the Outputable instance of PackageKey).

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

Test Plan: validate

Reviewers: austin, bgamari

Subscribers: thomie

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

GHC Trac Issues: #10566

13 files changed, 399 insertions, 41 deletions

diff --git a/compiler/backpack/ShPackageKey.hs b/compiler/backpack/ShPackageKey.hs
new file mode 100644
index 0000000000..9fc44ae5cb
--- /dev/null
+++ b/compiler/backpack/ShPackageKey.hs
@@ -0,0 +1,280 @@
+{-# LANGUAGE CPP #-}
+module ShPackageKey(
+    ShFreeHoles,
+    calcModuleFreeHoles,
+
+    newPackageKey,
+    newPackageKeyWithScope,
+    lookupPackageKey,
+
+    generalizeHoleModule,
+    canonicalizeModule,
+
+    pprPackageKey
+) where
+
+#include "HsVersions.h"
+
+import Module
+import Packages
+import FastString
+import UniqFM
+import UniqSet
+import Outputable
+import Util
+import DynFlags
+
+import System.IO.Unsafe ( unsafePerformIO )
+import Control.Monad
+import Numeric
+import Data.IORef
+import GHC.Fingerprint
+import Data.Word
+import qualified Data.Char as Char
+import Data.List
+import Data.Function
+
+-- NB: didn't put this in Module, that seems a bit too low in the
+-- hierarchy, need to refer to DynFlags
+
+{-
+************************************************************************
+*                                                                      *
+                        Package Keys
+*                                                                      *
+************************************************************************
+-}
+
+-- Note: [PackageKey cache]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- The built-in PackageKey type (used by Module, Name, etc)
+-- records the instantiation of the package as an MD5 hash
+-- which is not reversible without some extra information.
+-- However, the shape merging process requires us to be able
+-- to substitute Module occurrences /inside/ the package key.
+--
+-- Thus, we maintain the invariant: for every PackageKey
+-- in our system, either:
+--
+--      1. It is in the installed package database (lookupPackage)
+--         so we can lookup the recorded instantiatedWith
+--      2. We've recorded the associated mapping in the
+--         PackageKeyCache.
+--
+-- A PackageKey can be expanded into a ShPackageKey which has
+-- the instance mapping.  In the mapping, we don't bother
+-- expanding a 'Module'; depending on 'shPackageKeyFreeHoles',
+-- it may not be necessary to do a substitution (you only
+-- need to drill down when substituing HOLE:H if H is in scope.
+
+-- Note: [Module name in scope set]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Similar to InScopeSet, ShFreeHoles is an optimization that
+-- allows us to avoid expanding a PackageKey into an ShPackageKey
+-- if there isn't actually anything in the module expression that
+-- we can substitute.
+
+-- | Given a Name or Module, the 'ShFreeHoles' contains the set
+-- of free variables, i.e. HOLE:A modules, which may be substituted.
+-- If this set is empty no substitutions are possible.
+type ShFreeHoles = UniqSet ModuleName
+
+-- | Calculate the free holes of a 'Module'.
+calcModuleFreeHoles :: DynFlags -> Module -> IO ShFreeHoles
+calcModuleFreeHoles dflags m
+    | modulePackageKey m == holePackageKey = return (unitUniqSet (moduleName m))
+    | otherwise = do
+        shpk <- lookupPackageKey dflags (modulePackageKey m)
+        return $ case shpk of
+            ShDefinitePackageKey{} -> emptyUniqSet
+            ShPackageKey{ shPackageKeyFreeHoles = in_scope } -> in_scope
+
+-- | Calculate the free holes of the hole map @[('ModuleName', 'Module')]@.
+calcInstsFreeHoles :: DynFlags -> [(ModuleName, Module)] -> IO ShFreeHoles
+calcInstsFreeHoles dflags insts =
+    fmap unionManyUniqSets (mapM (calcModuleFreeHoles dflags . snd) insts)
+
+-- | Given a 'UnitName', a 'LibraryName', and sorted mapping of holes to
+-- their implementations, compute the 'PackageKey' associated with it, as well
+-- as the recursively computed 'ShFreeHoles' of holes that may be substituted.
+newPackageKeyWithScope :: DynFlags
+                       -> UnitName
+                       -> LibraryName
+                       -> [(ModuleName, Module)]
+                       -> IO (PackageKey, ShFreeHoles)
+newPackageKeyWithScope dflags pn vh insts = do
+    fhs <- calcInstsFreeHoles dflags insts
+    pk <- newPackageKey' dflags (ShPackageKey pn vh insts fhs)
+    return (pk, fhs)
+
+-- | Given a 'UnitName' and sorted mapping of holes to
+-- their implementations, compute the 'PackageKey' associated with it.
+-- (Analogous to 'newGlobalBinder').
+newPackageKey :: DynFlags
+              -> UnitName
+              -> LibraryName
+              -> [(ModuleName, Module)]
+              -> IO PackageKey
+newPackageKey dflags pn vh insts = do
+    (pk, _) <- newPackageKeyWithScope dflags pn vh insts
+    return pk
+
+-- | Given a 'ShPackageKey', compute the 'PackageKey' associated with it.
+-- This function doesn't calculate the 'ShFreeHoles', because it is
+-- provided with 'ShPackageKey'.
+newPackageKey' :: DynFlags -> ShPackageKey -> IO PackageKey
+newPackageKey' _ (ShDefinitePackageKey pk) = return pk
+newPackageKey' dflags
+               shpk@(ShPackageKey pn vh insts fhs) = do
+    ASSERTM( fmap (==fhs) (calcInstsFreeHoles dflags insts) )
+    let pk = mkPackageKey pn vh insts
+        pkt_var = pkgKeyCache dflags
+    pk_cache <- readIORef pkt_var
+    let consistent pk_cache = maybe True (==shpk) (lookupUFM pk_cache pk)
+    MASSERT( consistent pk_cache )
+    when (not (elemUFM pk pk_cache)) $
+        atomicModifyIORef' pkt_var (\pk_cache ->
+            -- Could race, but it's guaranteed to be the same
+            ASSERT( consistent pk_cache ) (addToUFM pk_cache pk shpk, ()))
+    return pk
+
+-- | Given a 'PackageKey', reverse lookup the 'ShPackageKey' associated
+-- with it.  This only gives useful information for keys which are
+-- created using 'newPackageKey' or the associated functions, or that are
+-- already in the installed package database, since we generally cannot reverse
+-- MD5 hashes.
+lookupPackageKey :: DynFlags
+                 -> PackageKey
+                 -> IO ShPackageKey
+lookupPackageKey dflags pk
+  | pk `elem` wiredInPackageKeys
+     || pk == mainPackageKey
+     || pk == holePackageKey
+  = return (ShDefinitePackageKey pk)
+  | otherwise = do
+    let pkt_var = pkgKeyCache dflags
+    pk_cache <- readIORef pkt_var
+    case lookupUFM pk_cache pk of
+        Just r -> return r
+        _ -> return (ShDefinitePackageKey pk)
+
+pprPackageKey :: PackageKey -> SDoc
+pprPackageKey pk = sdocWithDynFlags $ \dflags ->
+    -- name cache is a memotable
+    let shpk = unsafePerformIO (lookupPackageKey dflags pk)
+    in case shpk of
+        shpk@ShPackageKey{} ->
+            ppr (shPackageKeyUnitName shpk) <>
+                parens (hsep
+                    (punctuate comma [ ppUnless (moduleName m == modname)
+                                                (ppr modname <+> text "->")
+                                       <+> ppr m
+                                     | (modname, m) <- shPackageKeyInsts shpk]))
+            <> ifPprDebug (braces (ftext (packageKeyFS pk)))
+        ShDefinitePackageKey pk -> ftext (packageKeyFS pk)
+
+-- NB: newPackageKey and lookupPackageKey are mutually recursive; this
+-- recursion is guaranteed to bottom out because you can't set up cycles
+-- of PackageKeys.
+
+
+{-
+************************************************************************
+*                                                                      *
+                        Package key hashing
+*                                                                      *
+************************************************************************
+-}
+
+-- | Generates a 'PackageKey'.  Don't call this directly; you probably
+-- want to cache the result.
+mkPackageKey :: UnitName
+             -> LibraryName
+             -> [(ModuleName, Module)] -- hole instantiations
+             -> PackageKey
+mkPackageKey (UnitName fsUnitName)
+             (LibraryName fsLibraryName) unsorted_holes =
+    -- NB: don't use concatFS here, it's not much of an improvement
+    fingerprintPackageKey . fingerprintString $
+        unpackFS fsUnitName ++ "\n" ++
+        unpackFS fsLibraryName ++ "\n" ++
+        concat [ moduleNameString m
+                ++ " " ++ packageKeyString (modulePackageKey b)
+                ++ ":" ++ moduleNameString (moduleName b) ++ "\n"
+               | (m, b) <- sortBy (stableModuleNameCmp `on` fst) unsorted_holes]
+
+-- | Generalize a 'Module' into one where all the holes are indefinite.
+-- @p(A -> ...):C@ generalizes to @p(A -> HOLE:A):C@.  Useful when
+-- you need to figure out if you've already type-checked the generalized
+-- version of this module, so you don't have to do the whole rigamarole.
+generalizeHoleModule :: DynFlags -> Module -> IO Module
+generalizeHoleModule dflags m = do
+    pk <- generalizeHolePackageKey dflags (modulePackageKey m)
+    return (mkModule pk (moduleName m))
+
+-- | Generalize a 'PackageKey' into one where all the holes are indefinite.
+-- @p(A -> q():A) generalizes to p(A -> HOLE:A)@.
+generalizeHolePackageKey :: DynFlags -> PackageKey -> IO PackageKey
+generalizeHolePackageKey dflags pk = do
+    shpk <- lookupPackageKey dflags pk
+    case shpk of
+        ShDefinitePackageKey _ -> return pk
+        ShPackageKey { shPackageKeyUnitName = pn,
+                       shPackageKeyLibraryName = vh,
+                       shPackageKeyInsts = insts0 }
+          -> let insts = map (\(x, _) -> (x, mkModule holePackageKey x)) insts0
+             in newPackageKey dflags pn vh insts
+
+-- | Canonicalize a 'Module' so that it uniquely identifies a module.
+-- For example, @p(A -> M):A@ canonicalizes to @M@.  Useful for making
+-- sure the interface you've loaded as the right @mi_module@.
+canonicalizeModule :: DynFlags -> Module -> IO Module
+canonicalizeModule dflags m = do
+    let pk = modulePackageKey m
+    shpk <- lookupPackageKey dflags pk
+    return $ case shpk of
+        ShPackageKey { shPackageKeyInsts = insts }
+            | Just m' <- lookup (moduleName m) insts -> m'
+        _ -> m
+
+{-
+************************************************************************
+*                                                                      *
+                        Base 62
+*                                                                      *
+************************************************************************
+-}
+
+--------------------------------------------------------------------------
+-- Base 62
+
+-- The base-62 code is based off of 'locators'
+-- ((c) Operational Dynamics Consulting, BSD3 licensed)
+
+-- Note: Instead of base-62 encoding a single 128-bit integer
+-- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
+-- (2 * ceil(10.75) characters).  Luckily for us, it's the same number of
+-- characters!  In the long term, this should go in GHC.Fingerprint,
+-- but not now...
+
+-- | Size of a 64-bit word when written as a base-62 string
+word64Base62Len :: Int
+word64Base62Len = 11
+
+-- | Converts a 64-bit word into a base-62 string
+toBase62 :: Word64 -> String
+toBase62 w = pad ++ str
+  where
+    pad = replicate len '0'
+    len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)
+    str = showIntAtBase 62 represent w ""
+    represent :: Int -> Char
+    represent x
+        | x < 10 = Char.chr (48 + x)
+        | x < 36 = Char.chr (65 + x - 10)
+        | x < 62 = Char.chr (97 + x - 36)
+        | otherwise = error ("represent (base 62): impossible!")
+
+fingerprintPackageKey :: Fingerprint -> PackageKey
+fingerprintPackageKey (Fingerprint a b)
+    = stringToPackageKey (toBase62 a ++ toBase62 b)
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 536c536995..28227f32bf 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -124,6 +124,7 @@ Library
         cbits/genSym.c
 
     hs-source-dirs:
+        backpack
         basicTypes
         cmm
         codeGen
@@ -500,6 +501,7 @@ Library
         Vectorise
         Hoopl.Dataflow
         Hoopl
+        ShPackageKey
 --        CgInfoTbls used in ghci/DebuggerUtils
 --        CgHeapery  mkVirtHeapOffsets used in ghci
 
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ad604c8cfc..74e9bf303d 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -100,6 +100,10 @@ module DynFlags (
         parseDynamicFilePragma,
         parseDynamicFlagsFull,
 
+        -- ** Package key cache
+        PackageKeyCache,
+        ShPackageKey(..),
+
         -- ** Available DynFlags
         allFlags,
         flagsAll,
@@ -177,6 +181,8 @@ import Foreign.C        ( CInt(..) )
 import System.IO.Unsafe ( unsafeDupablePerformIO )
 #endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
+import UniqFM
+import UniqSet
 
 import System.IO.Unsafe ( unsafePerformIO )
 import Data.IORef
@@ -654,6 +660,29 @@ type SigOf = Map ModuleName Module
 getSigOf :: DynFlags -> ModuleName -> Maybe Module
 getSigOf dflags n = Map.lookup n (sigOf dflags)
 
+-- NameCache updNameCache
+type PackageKeyEnv = UniqFM
+type PackageKeyCache = PackageKeyEnv ShPackageKey
+
+-- | An elaborated representation of a 'PackageKey', which records
+-- all of the components that go into the hashed 'PackageKey'.
+data ShPackageKey
+    = ShPackageKey {
+          shPackageKeyUnitName          :: !UnitName,
+          shPackageKeyLibraryName       :: !LibraryName,
+          shPackageKeyInsts             :: ![(ModuleName, Module)],
+          shPackageKeyFreeHoles         :: UniqSet ModuleName
+      }
+    | ShDefinitePackageKey {
+          shPackageKey :: !PackageKey
+      }
+    deriving Eq
+
+instance Outputable ShPackageKey where
+    ppr (ShPackageKey pn vh insts fh)
+        = ppr pn <+> ppr vh <+> ppr insts <+> parens (ppr fh)
+    ppr (ShDefinitePackageKey pk) = ppr pk
+
 -- | Contains not only a collection of 'GeneralFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
@@ -698,7 +727,10 @@ data DynFlags = DynFlags {
   solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver
                                          --   Typically only 1 is needed
 
-  thisPackage           :: PackageKey,   -- ^ name of package currently being compiled
+  thisPackage           :: PackageKey,   -- ^ key of package currently being compiled
+  thisLibraryName       :: LibraryName,
+                            -- ^ the version hash which identifies the textual
+                            --   package being compiled.
 
   -- ways
   ways                  :: [Way],       -- ^ Way flags from the command line
@@ -785,6 +817,7 @@ data DynFlags = DynFlags {
   -- Packages.initPackages
   pkgDatabase           :: Maybe [PackageConfig],
   pkgState              :: PackageState,
+  pkgKeyCache           :: {-# UNPACK #-} !(IORef PackageKeyCache),
 
   -- Temporary files
   -- These have to be IORefs, because the defaultCleanupHandler needs to
@@ -1437,6 +1470,7 @@ defaultDynFlags mySettings =
         solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,
 
         thisPackage             = mainPackageKey,
+        thisLibraryName         = LibraryName nilFS,
 
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
@@ -1482,6 +1516,7 @@ defaultDynFlags mySettings =
         pkgDatabase             = Nothing,
         -- This gets filled in with GHC.setSessionDynFlags
         pkgState                = emptyPackageState,
+        pkgKeyCache             = v_unsafePkgKeyCache,
         ways                    = defaultWays mySettings,
         buildTag                = mkBuildTag (defaultWays mySettings),
         rtsBuildTag             = mkBuildTag (defaultWays mySettings),
@@ -2730,6 +2765,7 @@ package_flags = [
                                       upd (setPackageKey name)
                                       deprecate "Use -this-package-key instead")
   , defGhcFlag "this-package-key"   (hasArg setPackageKey)
+  , defGhcFlag "library-name"       (hasArg setLibraryName)
   , defFlag "package-id"            (HasArg exposePackageId)
   , defFlag "package"               (HasArg exposePackage)
   , defFlag "package-key"           (HasArg exposePackageKey)
@@ -3725,6 +3761,9 @@ exposePackage' p dflags
 setPackageKey :: String -> DynFlags -> DynFlags
 setPackageKey p s =  s{ thisPackage = stringToPackageKey p }
 
+setLibraryName :: String -> DynFlags -> DynFlags
+setLibraryName v s = s{ thisLibraryName = LibraryName (mkFastString v) }
+
 -- -----------------------------------------------------------------------------
 -- | Find the package environment (if one exists)
 --
@@ -4179,6 +4218,8 @@ unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
 setUnsafeGlobalDynFlags :: DynFlags -> IO ()
 setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
 
+GLOBAL_VAR(v_unsafePkgKeyCache, emptyUFM, PackageKeyCache)
+
 -- -----------------------------------------------------------------------------
 -- SSE and AVX
 
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 3c41151c11..71a84d8622 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -12,13 +12,18 @@ module PackageConfig (
         -- * PackageKey
         packageConfigId,
 
+        -- * LibraryName
+        LibraryName(..),
+
         -- * The PackageConfig type: information about a package
         PackageConfig,
         InstalledPackageInfo(..),
         InstalledPackageId(..),
         SourcePackageId(..),
         PackageName(..),
+        UnitName(..),
         Version(..),
+        packageUnitName,
         defaultPackageConfig,
         installedPackageIdString,
         sourcePackageIdString,
@@ -54,6 +59,8 @@ type PackageConfig = InstalledPackageInfo
 newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord)
 newtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)
 newtype PackageName        = PackageName        FastString deriving (Eq, Ord)
+newtype UnitName           = UnitName           FastString deriving (Eq, Ord)
+newtype LibraryName        = LibraryName        FastString deriving (Eq, Ord)
 
 instance BinaryStringRep InstalledPackageId where
   fromStringRep = InstalledPackageId . mkFastStringByteString
@@ -67,6 +74,10 @@ instance BinaryStringRep PackageName where
   fromStringRep = PackageName . mkFastStringByteString
   toStringRep (PackageName s) = fastStringToByteString s
 
+instance BinaryStringRep LibraryName where
+  fromStringRep = LibraryName . mkFastStringByteString
+  toStringRep (LibraryName s) = fastStringToByteString s
+
 instance Uniquable InstalledPackageId where
   getUnique (InstalledPackageId n) = getUnique n
 
@@ -79,6 +90,12 @@ instance Uniquable PackageName where
 instance Outputable InstalledPackageId where
   ppr (InstalledPackageId str) = ftext str
 
+instance Outputable UnitName where
+  ppr (UnitName str) = ftext str
+
+instance Outputable LibraryName where
+  ppr (LibraryName str) = ftext str
+
 instance Outputable SourcePackageId where
   ppr (SourcePackageId str) = ftext str
 
@@ -172,3 +189,6 @@ pprPackageConfig InstalledPackageInfo {..} =
 packageConfigId :: PackageConfig -> PackageKey
 packageConfigId = packageKey
 
+packageUnitName :: PackageConfig -> UnitName
+packageUnitName pkg = let PackageName fs = packageName pkg
+                      in UnitName fs
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 16ee352243..20822476cd 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -363,7 +363,7 @@ initPackages dflags = do
                 Nothing -> readPackageConfigs dflags
                 Just db -> return $ setBatchPackageFlags dflags db
   (pkg_state, preload, this_pkg)
-        <- mkPackageState dflags pkg_db [] (thisPackage dflags)
+        <- mkPackageState dflags pkg_db []
   return (dflags{ pkgDatabase = Just pkg_db,
                   pkgState = pkg_state,
                   thisPackage = this_pkg },
@@ -885,15 +885,17 @@ mkPackageState
     :: DynFlags
     -> [PackageConfig]          -- initial database
     -> [PackageKey]              -- preloaded packages
-    -> PackageKey                -- this package
     -> IO (PackageState,
            [PackageKey],         -- new packages to preload
            PackageKey) -- this package, might be modified if the current
                       -- package is a wired-in package.
 
-mkPackageState dflags0 pkgs0 preload0 this_package = do
+mkPackageState dflags0 pkgs0 preload0 = do
   dflags <- interpretPackageEnv dflags0
 
+  -- Compute the package key
+  let this_package = thisPackage dflags
+
 {-
    Plan.
 
diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml
index 555c67ffbc..1d3b4b4d7c 100644
--- a/docs/users_guide/packages.xml
+++ b/docs/users_guide/packages.xml
@@ -274,8 +274,22 @@ exposed-modules: Network.BSD,
           <para>Tells GHC the the module being compiled forms part of
             package key <replaceable>foo</replaceable>; internally, these
             keys are used to determine type equality and linker symbols.
-            If this flag is omitted (a very common case) then the
-            default package <literal>main</literal> is assumed.</para>
+            </para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term><option>-library-name</option> <replaceable>hash</replaceable>
+        <indexterm><primary><option>-library-name</option></primary>
+          </indexterm></term>
+        <listitem>
+          <para>Tells GHC that the source of a Backpack file and
+          its textual dependencies is uniquely identified by
+          <replaceable>hash</replaceable>.  Library names are determined
+          by Cabal; a usual recipe for a library name is that it is
+          the hash source package identifier of a package, as well as the
+          version hashes of all its textual dependencies.  GHC will
+          then use this library name to generate more package keys.</para>
         </listitem>
       </varlistentry>
 
@@ -1237,8 +1251,10 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf
     </itemizedlist>
 
      <para>To compile a module which is to be part of a new package,
-      use the <literal>-this-package-key</literal> option (<xref linkend="using-packages"/>).
-      Failure to use the <literal>-this-package-key</literal> option
+      use the <literal>-package-name</literal> (to identify the name of the package) and
+      <literal>-library-name</literal> (to identify the version and the version
+      hashes of its identities.) options (<xref linkend="using-packages"/>).
+      Failure to use these options
       when compiling a package will probably result in disaster, but
       you will only discover later when you attempt to import modules
       from the package.  At this point GHC will complain that the
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject 03530bf99d96f8e8ab00cd18a18222eeba06473
+Subproject f47732a50d4bd103c5660c2fbcd77cbce8c521b
diff --git a/testsuite/tests/cabal/sigcabal01/Makefile b/testsuite/tests/cabal/sigcabal01/Makefile
index c284842bdd..73cffd7a68 100644
--- a/testsuite/tests/cabal/sigcabal01/Makefile
+++ b/testsuite/tests/cabal/sigcabal01/Makefile
@@ -22,7 +22,7 @@ sigcabal01:
 	cd p && $(SETUP) build
 	cd p && $(SETUP) copy
 	cd p && $(SETUP) register --print-ipid > ../p_strict
-	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_lazy` (P as P.Lazy)" -package-id "`cat p_strict` (P as P.Strict)" --make Main.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -package-id "`cat p_lazy` (P as P.Lazy)" -package-id "`cat p_strict` (P as P.Strict)" --make Main.hs
 	! ./Main
 ifneq "$(CLEANUP)" ""
 	$(MAKE) clean
diff --git a/testsuite/tests/cabal/sigcabal01/all.T b/testsuite/tests/cabal/sigcabal01/all.T
index a797c0890d..24c50b672a 100644
--- a/testsuite/tests/cabal/sigcabal01/all.T
+++ b/testsuite/tests/cabal/sigcabal01/all.T
@@ -4,6 +4,6 @@ else:
    cleanup = ''
 
 test('sigcabal01',
-     normal,
+     expect_broken(10622),
      run_command,
      ['$MAKE -s --no-print-directory sigcabal01 ' + cleanup])
diff --git a/testsuite/tests/cabal/sigcabal02/Makefile b/testsuite/tests/cabal/sigcabal02/Makefile
index 152aaeac0e..c45697d1b6 100644
--- a/testsuite/tests/cabal/sigcabal02/Makefile
+++ b/testsuite/tests/cabal/sigcabal02/Makefile
@@ -21,9 +21,9 @@ sigcabal02:
 	cd q && $(SETUP) build
 	cd q && $(SETUP) copy
 	cd q && $(SETUP) register --print-ipid > ../q_ipid
-	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make Main.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make Main.hs
 	./Main
-	! '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs
+	! '$(TEST_HC)' $(TEST_HC_OPTS) -package-db=tmp.d -hide-all-packages -package base -package containers -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs
 ifneq "$(CLEANUP)" ""
 	$(MAKE) clean
 endif
diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
index 12223e534a..a3810ffb8b 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
@@ -29,17 +29,17 @@ trusted: safe
 require own pkg trusted: True
 
 M_SafePkg6
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg7
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0* ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg8
-package dependencies: array-0.5.1.0 bytestring-0.10.6.0* deepseq-1.4.1.1 base-4.8.2.0 ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
+package dependencies: bytestring-0.10.6.0* deepseq-1.4.1.1 array-0.5.1.0 base-4.8.2.0 ghc-prim-0.4.0.0 integer-gmp-1.0.0.0
 trusted: trustworthy
 require own pkg trusted: False
 
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index 1c0a217a05..98029ab3a8 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -4,9 +4,9 @@ TYPE CONSTRUCTORS
   data T (a :: k)
 COERCION AXIOMS
 Dependent modules: []
-Dependent packages: [array-0.5.1.0, deepseq-1.4.1.1,
-                     pretty-1.1.2.0, base-4.8.2.0, ghc-prim-0.4.0.0,
-                     integer-gmp-1.0.0.0, template-haskell-2.10.0.0]
+Dependent packages: [pretty-1.1.2.0, deepseq-1.4.1.1,
+                     array-0.5.1.0, base-4.8.2.0, ghc-prim-0.4.0.0, integer-gmp-1.0.0.0,
+                     template-haskell-2.10.0.0]
 
 ==================== Typechecker ====================
 
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index ed57fb8105..206b676031 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -292,21 +292,22 @@ fixupPackageId ipinfos (InstalledPackageId ipi)
 -- 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.
-mangleLbi :: FilePath -> FilePath -> LocalBuildInfo -> LocalBuildInfo
-mangleLbi "compiler" "stage2" lbi
+mangleIPI :: FilePath -> FilePath -> LocalBuildInfo
+          -> Installed.InstalledPackageInfo -> Installed.InstalledPackageInfo
+mangleIPI "compiler" "stage2" lbi ipi
  | isWindows =
-    let ccs' = [ (cn, updateComponentLocalBuildInfo clbi, cns)
-               | (cn, clbi, cns) <- componentsConfigs lbi ]
-        updateComponentLocalBuildInfo clbi@(LibComponentLocalBuildInfo {})
-            = let cls' = concat [ [ LibraryName n, LibraryName (n ++ "-0") ]
-                                | LibraryName n <- componentLibraries clbi ]
-              in clbi { componentLibraries = cls' }
-        updateComponentLocalBuildInfo clbi = clbi
-    in lbi { componentsConfigs = ccs' }
+    -- Cabal currently only ever installs ONE Haskell library, c.f.
+    -- the code in Cabal.Distribution.Simple.Register.  If it
+    -- ever starts installing more we'll have to find the
+    -- library that's too big and split that.
+    let [old_hslib] = Installed.hsLibraries ipi
+    in ipi {
+        Installed.hsLibraries = [old_hslib, old_hslib ++ "-0"]
+    }
     where isWindows = case hostPlatform lbi of
                       Platform _ Windows -> True
                       _                  -> False
-mangleLbi _ _ lbi = lbi
+mangleIPI _ _ _ ipi = ipi
 
 generate :: FilePath -> FilePath -> String -> [String] -> IO ()
 generate directory distdir dll0Modules config_args
@@ -318,9 +319,8 @@ generate directory distdir dll0Modules config_args
       withArgs (["configure", "--distdir", distdir] ++ config_args)
                runDefaultMain
 
-      lbi0 <- getPersistBuildConfig distdir
-      let lbi = mangleLbi directory distdir lbi0
-          pd0 = localPkgDescr lbi
+      lbi <- getPersistBuildConfig distdir
+      let pd0 = localPkgDescr lbi
 
       writePersistBuildConfig distdir lbi
 
@@ -345,7 +345,7 @@ generate directory distdir dll0Modules config_args
              let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
              let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
                                         pd ipid lib lbi clbi
-                 final_ipi = installedPkgInfo {
+                 final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo {
                                  Installed.installedPackageId = ipid,
                                  Installed.haddockHTMLs = []
                              }
@@ -405,9 +405,7 @@ generate directory distdir dll0Modules config_args
           dep_ipids = map (display . Installed.installedPackageId) dep_direct
           depLibNames
             | packageKeySupported comp
-                = map (\p -> packageKeyLibraryName
-                                (Installed.sourcePackageId p)
-                                (Installed.packageKey p)) dep_direct
+                = map (display . Installed.libraryName) dep_direct
             | otherwise = deps
           depNames = map (display . packageName) dep_ids
 
@@ -415,9 +413,7 @@ generate directory distdir dll0Modules config_args
           transitiveDeps = map display transitive_dep_ids
           transitiveDepLibNames
             | packageKeySupported comp
-                = map (\p -> packageKeyLibraryName
-                                (Installed.sourcePackageId p)
-                                (Installed.packageKey p)) dep_pkgs
+                = map (display . Installed.libraryName) dep_pkgs
             | otherwise = transitiveDeps
           transitiveDepNames = map (display . packageName) transitive_dep_ids
 
@@ -437,9 +433,10 @@ generate directory distdir dll0Modules config_args
           otherMods = map display (otherModules bi)
           allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
-                variablePrefix ++ "_PACKAGE_KEY = " ++ display (pkgKey lbi),
+                -- TODO: move inside withLibLBI
+                variablePrefix ++ "_PACKAGE_KEY = " ++ display (localPackageKey lbi),
                 -- copied from mkComponentsLocalBuildInfo
-                variablePrefix ++ "_LIB_NAME = " ++ packageKeyLibraryName (package pd) (pkgKey lbi),
+                variablePrefix ++ "_LIB_NAME = " ++ display (localLibraryName lbi),
                 variablePrefix ++ "_MODULES = " ++ unwords mods,
                 variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,