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

4 files changed, 94 insertions, 181 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1f04f60562..c03f076ef0 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1913,7 +1913,7 @@ parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of
             m <- tok $ parseModule
             return (n, m)
         parseModule = do
-            pk <- munch1 (\c -> isAlphaNum c || c `elem` "-_")
+            pk <- munch1 (\c -> isAlphaNum c || c `elem` "-_.")
             _ <- R.char ':'
             m <- parseModuleName
             return (mkModule (stringToPackageKey pk) m)
@@ -4072,6 +4072,7 @@ compilerInfo dflags
        ("Support parallel --make",     "YES"),
        ("Support reexported-modules",  "YES"),
        ("Support thinning and renaming package flags", "YES"),
+       ("Requires unified installed package IDs", "YES"),
        ("Uses package keys",           "YES"),
        ("Dynamic by default",          if dYNAMIC_BY_DEFAULT dflags
                                        then "YES" else "NO"),
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 2c426d9b36..31d22eb3f0 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1543,15 +1543,8 @@ Note [Printing package keys]
 In the old days, original names were tied to PackageIds, which directly
 corresponded to the entities that users wrote in Cabal files, and were perfectly
 suitable for printing when we need to disambiguate packages.  However, with
-PackageKey, the situation is different.  First, the key is not a human readable
-at all, so we need to consult the package database to find the appropriate
-PackageId to display.  Second, there may be multiple copies of a library visible
-with the same PackageId, in which case we need to disambiguate.  For now,
-we just emit the actual package key (which the user can go look up); however,
-another scheme is to (recursively) say which dependencies are different.
-
-NB: When we extend package keys to also have holes, we will have to disambiguate
-those as well.
+PackageKey, the situation can be different: if the key is instantiated with
+some holes, we should try to give the user some more useful information.
 -}
 
 -- | Creates some functions that work out the best ways to format
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 9e9775bc04..4ba8344e77 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -128,7 +128,6 @@ pprPackageConfig InstalledPackageInfo {..} =
       field "name"                 (ppr packageName),
       field "version"              (text (showVersion packageVersion)),
       field "id"                   (ppr installedPackageId),
-      field "key"                  (ppr packageKey),
       field "exposed"              (ppr exposed),
       field "exposed-modules"
         (if all isExposedModule exposedModules
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index bb0aba241e..3b9526129f 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -18,7 +18,6 @@ module Packages (
 
         -- * Querying the package config
         lookupPackage,
-        resolveInstalledPackageId,
         searchPackageId,
         getPackageDetails,
         listVisibleModuleNames,
@@ -249,24 +248,17 @@ data PackageState = PackageState {
   -- | This is a full map from 'ModuleName' to all modules which may possibly
   -- be providing it.  These providers may be hidden (but we'll still want
   -- to report them in error messages), or it may be an ambiguous import.
-  moduleToPkgConfAll    :: ModuleToPkgConfAll,
-
-  -- | This is a map from 'InstalledPackageId' to 'PackageKey', since GHC
-  -- internally deals in package keys but the database may refer to installed
-  -- package IDs.
-  installedPackageIdMap :: InstalledPackageIdMap
+  moduleToPkgConfAll    :: ModuleToPkgConfAll
   }
 
 emptyPackageState :: PackageState
 emptyPackageState = PackageState {
     pkgIdMap = emptyUFM,
     preloadPackages = [],
-    moduleToPkgConfAll = Map.empty,
-    installedPackageIdMap = Map.empty
+    moduleToPkgConfAll = Map.empty
     }
 
-type InstalledPackageIdMap = Map InstalledPackageId PackageKey
-type InstalledPackageIndex = Map InstalledPackageId PackageConfig
+type InstalledPackageIndex = Map PackageKey PackageConfig
 
 -- | Empty package configuration map
 emptyPackageConfigMap :: PackageConfigMap
@@ -304,12 +296,6 @@ getPackageDetails dflags pid =
 listPackageConfigMap :: DynFlags -> [PackageConfig]
 listPackageConfigMap dflags = eltsUFM (pkgIdMap (pkgState dflags))
 
--- | Looks up a 'PackageKey' given an 'InstalledPackageId'
-resolveInstalledPackageId :: DynFlags -> InstalledPackageId -> PackageKey
-resolveInstalledPackageId dflags ipid =
-    expectJust "resolveInstalledPackageId"
-        (Map.lookup ipid (installedPackageIdMap (pkgState dflags)))
-
 -- ----------------------------------------------------------------------------
 -- Loading the package db files and building up the package state
 
@@ -602,7 +588,7 @@ packageFlagErr dflags flag reasons
                       text "(use -v for more information)")
         ppr_reasons = vcat (map ppr_reason reasons)
         ppr_reason (p, reason) =
-            pprReason (ppr (installedPackageId p) <+> text "is") reason
+            pprReason (ppr (packageKey p) <+> text "is") reason
 
 pprFlag :: PackageFlag -> SDoc
 pprFlag flag = case flag of
@@ -628,11 +614,13 @@ pprFlag flag = case flag of
 wired_in_pkgids :: [String]
 wired_in_pkgids = map packageKeyString wiredInPackageKeys
 
+type WiredPackagesMap = Map PackageKey PackageKey
+
 findWiredInPackages
    :: DynFlags
    -> [PackageConfig]           -- database
    -> VisibilityMap             -- info on what packages are visible
-   -> IO ([PackageConfig], VisibilityMap)
+   -> IO ([PackageConfig], VisibilityMap, WiredPackagesMap)
 
 findWiredInPackages dflags pkgs vis_map = do
   --
@@ -686,14 +674,14 @@ findWiredInPackages dflags pkgs vis_map = do
                             ptext (sLit "wired-in package ")
                                  <> text wired_pkg
                                  <> ptext (sLit " mapped to ")
-                                 <> ppr (installedPackageId pkg)
+                                 <> ppr (packageKey pkg)
                         return (Just pkg)
 
 
   mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids
   let
         wired_in_pkgs = catMaybes mb_wired_in_pkgs
-        wired_in_ids = map installedPackageId wired_in_pkgs
+        wired_in_ids = map packageKey wired_in_pkgs
 
         -- this is old: we used to assume that if there were
         -- multiple versions of wired-in packages installed that
@@ -708,14 +696,28 @@ findWiredInPackages dflags pkgs vis_map = do
                       && package p `notElem` map fst wired_in_ids
         -}
 
-        updateWiredInDependencies pkgs = map upd_pkg pkgs
+        wiredInMap :: Map PackageKey PackageKey
+        wiredInMap = foldl' add_mapping Map.empty pkgs
+          where add_mapping m pkg
+                  | let key = packageKey pkg
+                  , key `elem` wired_in_ids
+                  = Map.insert key (stringToPackageKey (packageNameString pkg)) m
+                  | otherwise = m
+
+        updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs
           where upd_pkg pkg
-                  | installedPackageId pkg `elem` wired_in_ids
+                  | packageKey pkg `elem` wired_in_ids
                   = pkg {
                       packageKey = stringToPackageKey (packageNameString pkg)
                     }
                   | otherwise
                   = pkg
+                upd_deps pkg = pkg {
+                      depends = map upd_wired_in (depends pkg)
+                    }
+                upd_wired_in key
+                    | Just key' <- Map.lookup key wiredInMap = key'
+                    | otherwise = key
 
         updateVisibilityMap vis_map = foldl' f vis_map wired_in_pkgs
           where f vm p = case lookupUFM vis_map (packageConfigId p) of
@@ -724,16 +726,15 @@ findWiredInPackages dflags pkgs vis_map = do
                                                     (packageNameString p)) r
 
 
-  return (updateWiredInDependencies pkgs, updateVisibilityMap vis_map)
+  return (updateWiredInDependencies pkgs, updateVisibilityMap vis_map, wiredInMap)
 
 -- ----------------------------------------------------------------------------
 
 data UnusablePackageReason
   = IgnoredWithFlag
-  | MissingDependencies [InstalledPackageId]
-  | ShadowedBy InstalledPackageId
+  | MissingDependencies [PackageKey]
 
-type UnusablePackages = Map InstalledPackageId
+type UnusablePackages = Map PackageKey
                             (PackageConfig, UnusablePackageReason)
 
 pprReason :: SDoc -> UnusablePackageReason -> SDoc
@@ -744,8 +745,6 @@ pprReason pref reason = case reason of
       pref <+>
       ptext (sLit "unusable due to missing or recursive dependencies:") $$
         nest 2 (hsep (map ppr deps))
-  ShadowedBy ipid ->
-      pref <+> ptext (sLit "shadowed by package ") <> ppr ipid
 
 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
@@ -770,62 +769,31 @@ findBroken pkgs = go [] Map.empty pkgs
    go avail ipids not_avail =
      case partitionWith (depsAvailable ipids) not_avail of
         ([], not_avail) ->
-            Map.fromList [ (installedPackageId p, (p, MissingDependencies deps))
+            Map.fromList [ (packageKey p, (p, MissingDependencies deps))
                          | (p,deps) <- not_avail ]
         (new_avail, not_avail) ->
             go (new_avail ++ avail) new_ipids (map fst not_avail)
             where new_ipids = Map.insertList
-                                [ (installedPackageId p, p) | p <- new_avail ]
+                                [ (packageKey p, p) | p <- new_avail ]
                                 ipids
 
    depsAvailable :: InstalledPackageIndex
                  -> PackageConfig
-                 -> Either PackageConfig (PackageConfig, [InstalledPackageId])
+                 -> Either PackageConfig (PackageConfig, [PackageKey])
    depsAvailable ipids pkg
         | null dangling = Left pkg
         | otherwise     = Right (pkg, dangling)
         where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
 
 -- -----------------------------------------------------------------------------
--- Eliminate shadowed packages, giving the user some feedback
-
--- later packages in the list should shadow earlier ones with the same
--- package name/version.  Additionally, a package may be preferred if
--- it is in the transitive closure of packages selected using -package-id
--- flags.
-type UnusablePackage = (PackageConfig, UnusablePackageReason)
-shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
-shadowPackages pkgs preferred
- = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
-   in  Map.fromList shadowed
- where
- check :: ([(InstalledPackageId, UnusablePackage)], UniqFM PackageConfig)
-       -> PackageConfig
-       -> ([(InstalledPackageId, UnusablePackage)], UniqFM PackageConfig)
- check (shadowed,pkgmap) pkg
-      | Just oldpkg <- lookupUFM pkgmap pkgid
-      , let
-            ipid_new = installedPackageId pkg
-            ipid_old = installedPackageId oldpkg
-        --
-      , ipid_old /= ipid_new
-      = if ipid_old `elem` preferred
-           then ((ipid_new, (pkg, ShadowedBy ipid_old)) : shadowed, pkgmap)
-           else ((ipid_old, (oldpkg, ShadowedBy ipid_new)) : shadowed, pkgmap')
-      | otherwise
-      = (shadowed, pkgmap')
-      where
-        pkgid = packageKeyFS (packageKey pkg)
-        pkgmap' = addToUFM pkgmap pkgid pkg
-
--- -----------------------------------------------------------------------------
+-- Ignore packages
 
 ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
 ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
   where
   doit (IgnorePackage str) =
      case partition (matchingStr str) pkgs of
-         (ps, _) -> [ (installedPackageId p, (p, IgnoredWithFlag))
+         (ps, _) -> [ (packageKey p, (p, IgnoredWithFlag))
                     | p <- ps ]
         -- missing package is not an error for -ignore-package,
         -- because a common usage is to -ignore-package P as
@@ -833,20 +801,6 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
   doit _ = panic "ignorePackages"
 
 -- -----------------------------------------------------------------------------
-
-depClosure :: InstalledPackageIndex
-           -> [InstalledPackageId]
-           -> [InstalledPackageId]
-depClosure index ipids = closure Map.empty ipids
-  where
-   closure set [] = Map.keys set
-   closure set (ipid : ipids)
-     | ipid `Map.member` set = closure set ipids
-     | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
-                                                 (depends p ++ ipids)
-     | otherwise = closure set ipids
-
--- -----------------------------------------------------------------------------
 -- When all the command-line options are in, we can process our package
 -- settings and populate the package state.
 
@@ -868,80 +822,66 @@ mkPackageState dflags0 pkgs0 preload0 = do
 {-
    Plan.
 
-   1. P = transitive closure of packages selected by -package-id
-
-   2. Apply shadowing.  When there are multiple packages with the same
-      packageKey,
-        * if one is in P, use that one
-        * otherwise, use the one highest in the package stack
-      [
-       rationale: we cannot use two packages with the same packageKey
-       in the same program, because packageKey is the symbol prefix.
-       Hence we must select a consistent set of packages to use.  We have
-       a default algorithm for doing this: packages higher in the stack
-       shadow those lower down.  This default algorithm can be overriden
-       by giving explicit -package-id flags; then we have to take these
-       preferences into account when selecting which other packages are
-       made available.
-
-       Our simple algorithm throws away some solutions: there may be other
-       consistent sets that would satisfy the -package flags, but it's
-       not GHC's job to be doing constraint solving.
-      ]
-
-   3. remove packages selected by -ignore-package
-
-   4. remove any packages with missing dependencies, or mutually recursive
+   1. When there are multiple packages with the same
+      installed package ID, if they have the same ABI hash, use the one
+      highest in the package stack.  Otherwise, error.
+
+   2. remove packages selected by -ignore-package
+
+   3. remove any packages with missing dependencies, or mutually recursive
       dependencies.
 
-   5. report (with -v) any packages that were removed by steps 2-4
+   4. report (with -v) any packages that were removed by steps 2-4
 
-   6. apply flags to set exposed/hidden on the resulting packages
+   5. apply flags to set exposed/hidden on the resulting packages
       - if any flag refers to a package which was removed by 2-4, then
         we can give an error message explaining why
 
-   7. hide any packages which are superseded by later exposed packages
+   6. hide any packages which are superseded by later exposed packages
 -}
 
   let
-      flags = reverse (packageFlags dflags)
-
       -- pkgs0 with duplicate packages filtered out.  This is
       -- important: it is possible for a package in the global package
-      -- DB to have the same IPID as a package in the user DB, and
-      -- we want the latter to take precedence.  This is not the same
-      -- as shadowing (below), since in this case the two packages
-      -- have the same ABI and are interchangeable.
+      -- DB to have the same key as a package in the user DB, and
+      -- we want the latter to take precedence.
       --
-      -- #4072: note that we must retain the ordering of the list here
-      -- so that shadowing behaves as expected when we apply it later.
-      pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
-          where del p (s,ps)
-                  | pid `Set.member` s = (s,ps)
-                  | otherwise          = (Set.insert pid s, p:ps)
-                  where pid = installedPackageId p
-          -- XXX this is just a variant of nub
-
-      ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
-
-      ipid_selected = depClosure ipid_map
-                                 [ InstalledPackageId (mkFastString i)
-                                 | ExposePackage (PackageIdArg i) _ <- flags ]
-
+      -- NB: We have to check that the ABIs of the old and new packages
+      -- are equal; if they are not that's a fatal error.
+      --
+      -- TODO: might be useful to report when this shadowing occurs
+      (_, pkgs0_unique, abis) = foldr del (Set.empty,[],Map.empty) pkgs0
+          where del p (s,ps,a)
+                  | key `Set.member` s = (s,ps,a')
+                  | otherwise          = (Set.insert key s, p:ps, a')
+                  where key = packageKey p
+                        a' = Map.insertWith Set.union key
+                                            (Set.singleton (abiHash p)) a
+      failed_abis = [ (key, Set.toList as)
+                    | (key, as) <- Map.toList abis
+                    , Set.size as > 1 ]
+
+  unless (null failed_abis) $ do
+    throwGhcException (CmdLineError (showSDoc dflags
+        (text "package db: duplicate packages with incompatible ABIs:" $$
+         nest 4 (vcat [ ppr key <+> text "has ABIs" <> colon <+>
+                        hsep (punctuate comma (map text as))
+                      | (key, as) <- failed_abis]))))
+
+  let flags = reverse (packageFlags dflags)
       (ignore_flags, other_flags) = partition is_ignore flags
       is_ignore IgnorePackage{} = True
       is_ignore _ = False
 
-      shadowed = shadowPackages pkgs0_unique ipid_selected
       ignored  = ignorePackages ignore_flags pkgs0_unique
 
-      isBroken = (`Map.member` (Map.union shadowed ignored)).installedPackageId
+      isBroken = (`Map.member` ignored).packageKey
       pkgs0' = filter (not . isBroken) pkgs0_unique
 
       broken   = findBroken pkgs0'
 
-      unusable = shadowed `Map.union` ignored `Map.union` broken
-      pkgs1 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs0'
+      unusable = ignored `Map.union` broken
+      pkgs1 = filter (not . (`Map.member` unusable) . packageKey) pkgs0'
 
   reportUnusable dflags unusable
 
@@ -980,7 +920,7 @@ mkPackageState dflags0 pkgs0 preload0 = do
   -- package arguments we need to key against the old versions.  We also
   -- have to update the visibility map in the process.
   --
-  (pkgs3, vis_map) <- findWiredInPackages dflags pkgs2 vis_map2
+  (pkgs3, vis_map, wired_map) <- findWiredInPackages dflags pkgs2 vis_map2
 
   --
   -- Here we build up a set of the packages mentioned in -package
@@ -989,7 +929,9 @@ mkPackageState dflags0 pkgs0 preload0 = do
   -- should contain at least rts & base, which is why we pretend that
   -- the command line contains -package rts & -package base.
   --
-  let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
+  let preload1 = [ let key = packageKey p
+                   in fromMaybe key (Map.lookup key wired_map)
+                 | f <- flags, p <- get_exposed f ]
 
       get_exposed (ExposePackage a _) = take 1 . sortByVersion
                                       . filter (matching a)
@@ -998,14 +940,7 @@ mkPackageState dflags0 pkgs0 preload0 = do
 
   let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs3
 
-      ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
-                              | p <- pkgs3 ]
-
-      lookupIPID ipid
-         | Just pid <- Map.lookup ipid ipid_map = return pid
-         | otherwise                            = missingPackageErr dflags ipid
-
-  preload2 <- mapM lookupIPID preload1
+  let preload2 = preload1
 
   let
       -- add base & rts to the preload packages
@@ -1021,14 +956,13 @@ mkPackageState dflags0 pkgs0 preload0 = do
                      $ (basicLinkedPackages ++ preload2)
 
   -- Close the preload packages with their dependencies
-  dep_preload <- closeDeps dflags pkg_db ipid_map (zip preload3 (repeat Nothing))
+  dep_preload <- closeDeps dflags pkg_db (zip preload3 (repeat Nothing))
   let new_dep_preload = filter (`notElem` preload0) dep_preload
 
   let pstate = PackageState{
     preloadPackages     = dep_preload,
     pkgIdMap            = pkg_db,
-    moduleToPkgConfAll  = mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map,
-    installedPackageIdMap = ipid_map
+    moduleToPkgConfAll  = mkModuleToPkgConfAll dflags pkg_db vis_map
     }
   return (pstate, new_dep_preload, this_package)
 
@@ -1039,10 +973,9 @@ mkPackageState dflags0 pkgs0 preload0 = do
 mkModuleToPkgConfAll
   :: DynFlags
   -> PackageConfigMap
-  -> InstalledPackageIdMap
   -> VisibilityMap
   -> ModuleToPkgConfAll
-mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map =
+mkModuleToPkgConfAll dflags pkg_db vis_map =
     foldl' extend_modmap emptyMap (eltsUFM pkg_db)
  where
   emptyMap = Map.empty
@@ -1078,9 +1011,8 @@ mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map =
      let (pk', m', pkg', origin') =
           case exposedReexport of
            Nothing -> (pk, m, pkg, fromExposedModules e)
-           Just (OriginalModule ipid' m') ->
-            let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map)
-                pkg' = pkg_lookup pk'
+           Just (OriginalModule pk' m') ->
+            let pkg' = pkg_lookup pk'
             in (pk', m', pkg', fromReexportedModules e pkg')
      return (m, sing pk' m' pkg' origin')
 
@@ -1298,22 +1230,20 @@ getPreloadPackagesAnd dflags pkgids =
   let
       state   = pkgState dflags
       pkg_map = pkgIdMap state
-      ipid_map = installedPackageIdMap state
       preload = preloadPackages state
       pairs = zip pkgids (repeat Nothing)
   in do
-  all_pkgs <- throwErr dflags (foldM (add_package pkg_map ipid_map) preload pairs)
+  all_pkgs <- throwErr dflags (foldM (add_package pkg_map) preload pairs)
   return (map (getPackageDetails dflags) all_pkgs)
 
 -- Takes a list of packages, and returns the list with dependencies included,
 -- in reverse dependency order (a package appears before those it depends on).
 closeDeps :: DynFlags
           -> PackageConfigMap
-          -> Map InstalledPackageId PackageKey
           -> [(PackageKey, Maybe PackageKey)]
           -> IO [PackageKey]
-closeDeps dflags pkg_map ipid_map ps
-    = throwErr dflags (closeDepsErr pkg_map ipid_map ps)
+closeDeps dflags pkg_map ps
+    = throwErr dflags (closeDepsErr pkg_map ps)
 
 throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
 throwErr dflags m
@@ -1322,18 +1252,16 @@ throwErr dflags m
                 Succeeded r -> return r
 
 closeDepsErr :: PackageConfigMap
-             -> Map InstalledPackageId PackageKey
              -> [(PackageKey,Maybe PackageKey)]
              -> MaybeErr MsgDoc [PackageKey]
-closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
+closeDepsErr pkg_map ps = foldM (add_package pkg_map) [] ps
 
 -- internal helper
 add_package :: PackageConfigMap
-            -> Map InstalledPackageId PackageKey
             -> [PackageKey]
             -> (PackageKey,Maybe PackageKey)
             -> MaybeErr MsgDoc [PackageKey]
-add_package pkg_db ipid_map ps (p, mb_parent)
+add_package pkg_db ps (p, mb_parent)
   | p `elem` ps = return ps     -- Check if we've already added this package
   | otherwise =
       case lookupPackage' pkg_db p of
@@ -1341,19 +1269,11 @@ add_package pkg_db ipid_map ps (p, mb_parent)
                            missingDependencyMsg mb_parent)
         Just pkg -> do
            -- Add the package's dependents also
-           ps' <- foldM add_package_ipid ps (depends pkg)
+           ps' <- foldM add_unit_key ps (depends pkg)
            return (p : ps')
           where
-            add_package_ipid ps ipid
-              | Just pid <- Map.lookup ipid ipid_map
-              = add_package pkg_db ipid_map ps (pid, Just p)
-              | otherwise
-              = Failed (missingPackageMsg ipid
-                          <> missingDependencyMsg mb_parent)
-
-missingPackageErr :: Outputable pkgid => DynFlags -> pkgid -> IO a
-missingPackageErr dflags p
-    = throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
+            add_unit_key ps key
+              = add_package pkg_db ps (key, Just p)
 
 missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
 missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p
@@ -1420,7 +1340,7 @@ pprPackagesWith pprIPI dflags =
 -- be different from the package databases (exposure, trust)
 pprPackagesSimple :: DynFlags -> SDoc
 pprPackagesSimple = pprPackagesWith pprIPI
-    where pprIPI ipi = let InstalledPackageId i = installedPackageId ipi
+    where pprIPI ipi = let i = packageKeyFS (packageKey ipi)
                            e = if exposed ipi then text "E" else text " "
                            t = if trusted ipi then text "T" else text " "
                        in e <> t <> text "  " <> ftext i