Correctly handle wired in unit IDs in -instantiated-with

Summary:
To handle wired in packages, we must rewrite all occurrences
of unit ids like base-4.9.0.0 to base.  However, I forgot
to do this on unit ids that occurred in unit identifiers
passed via -instantiated-with.  This patch handles that case,
plus a test.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: bgamari, austin

Subscribers: rwbarton, thomie

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

compiler/main/Packages.hs

@@ -471,10 +471,11 @@ initPackages dflags0 = do
         Nothing -> readPackageConfigs dflags
         Just db -> return $ map (\(p, pkgs)
                                     -> (p, setBatchPackageFlags dflags pkgs)) db
-  (pkg_state, preload)
+  (pkg_state, preload, insts)
         <- mkPackageState dflags pkg_db []
   return (dflags{ pkgDatabase = Just pkg_db,
-                  pkgState = pkg_state },
+                  pkgState = pkg_state,
+                  thisUnitIdInsts_ = insts },
           preload)
 
 -- -----------------------------------------------------------------------------
@@ -1069,25 +1070,36 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
                   = pkg
                 upd_deps pkg = pkg {
                       -- temporary harmless DefUnitId invariant violation
-                      depends = map (unDefUnitId . upd_wired_in . DefUnitId) (depends pkg),
+                      depends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (depends pkg),
                       exposedModules
-                        = map (\(k,v) -> (k, fmap upd_wired_in_mod v))
+                        = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))
                               (exposedModules pkg)
                     }
-                upd_wired_in_mod (Module uid m) = Module (upd_wired_in_uid uid) m
-                upd_wired_in_uid (DefiniteUnitId def_uid) =
-                    DefiniteUnitId (upd_wired_in def_uid)
-                upd_wired_in_uid (IndefiniteUnitId indef_uid) =
-                    IndefiniteUnitId $ newIndefUnitId
-                        (indefUnitIdComponentId indef_uid)
-                        (map (\(x,y) -> (x,upd_wired_in_mod y)) (indefUnitIdInsts indef_uid))
-                upd_wired_in key
-                    | Just key' <- Map.lookup key wiredInMap = key'
-                    | otherwise = key
 
 
   return (updateWiredInDependencies pkgs, wiredInMap)
 
+-- Helper functions for rewiring Module and UnitId.  These
+-- rewrite UnitIds of modules in wired-in packages to the form known to the
+-- compiler. For instance, base-4.9.0.0 will be rewritten to just base, to match
+-- what appears in PrelNames.
+
+upd_wired_in_mod :: WiredPackagesMap -> Module -> Module
+upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
+
+upd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId
+upd_wired_in_uid wiredInMap (DefiniteUnitId def_uid) =
+    DefiniteUnitId (upd_wired_in wiredInMap def_uid)
+upd_wired_in_uid wiredInMap (IndefiniteUnitId indef_uid) =
+    IndefiniteUnitId $ newIndefUnitId
+        (indefUnitIdComponentId indef_uid)
+        (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (indefUnitIdInsts indef_uid))
+
+upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId
+upd_wired_in wiredInMap key
+    | Just key' <- Map.lookup key wiredInMap = key'
+    | otherwise = key
+
 updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
 updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
   where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of
@@ -1344,12 +1356,10 @@ mkPackageState
     -> [(FilePath, [PackageConfig])]
     -> [PreloadUnitId]              -- preloaded packages
     -> IO (PackageState,
-           [PreloadUnitId])         -- new packages to preload
+           [PreloadUnitId],         -- new packages to preload
+           Maybe [(ModuleName, Module)])
 
 mkPackageState dflags dbs preload0 = do
-  -- Compute the unit id
-  let this_package = thisPackage dflags
-
 {-
    Plan.
 
@@ -1541,7 +1551,10 @@ mkPackageState dflags dbs preload0 = do
       -- but in any case remove the current package from the set of
       -- preloaded packages so that base/rts does not end up in the
       -- set up preloaded package when we are just building it
-      preload3 = nub $ filter (/= this_package)
+      -- (NB: since this is only relevant for base/rts it doesn't matter
+      -- that thisUnitIdInsts_ is not wired yet)
+      --
+      preload3 = nub $ filter (/= thisPackage dflags)
                      $ (basicLinkedPackages ++ preload2)
 
   -- Close the preload packages with their dependencies
@@ -1564,7 +1577,8 @@ mkPackageState dflags dbs preload0 = do
     unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ],
     requirementContext = req_ctx
     }
-  return (pstate, new_dep_preload)
+  let new_insts = fmap (map (fmap (upd_wired_in_mod wired_map))) (thisUnitIdInsts_ dflags)
+  return (pstate, new_dep_preload, new_insts)
 
 -- | Given a wired-in 'UnitId', "unwire" it into the 'UnitId'
 -- that it was recorded as in the package database.

testsuite/tests/backpack/cabal/bkpcabal07/M.hs

+module M where

testsuite/tests/backpack/cabal/bkpcabal07/Makefile

+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP='$(PWD)/Setup' -v0
+CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst'
+
+# This test checks that instantiating an indefinite package
+# with a wired in package works.
+
+bkpcabal07: clean
+	$(MAKE) -s --no-print-directory clean
+	'$(GHC_PKG)' init tmp.d
+	'$(TEST_HC)' -v0 --make Setup
+	$(CONFIGURE)
+	$(SETUP) build
+ifneq "$(CLEANUP)" ""
+	$(MAKE) -s --no-print-directory clean
+endif
+
+clean :
+	$(RM) -rf tmp.d inst dist Setup$(exeext)

testsuite/tests/backpack/cabal/bkpcabal07/P.hsig

+signature P where

testsuite/tests/backpack/cabal/bkpcabal07/Setup.hs

+import Distribution.Simple
+main = defaultMain

testsuite/tests/backpack/cabal/bkpcabal07/all.T

+if config.cleanup:
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = 'CLEANUP=0'
+
+test('bkpcabal07',
+     extra_files(['bkpcabal07.cabal', 'Setup.hs', 'M.hs', 'P.hsig']),
+     run_command,
+     ['$MAKE -s --no-print-directory bkpcabal07 ' + cleanup])

testsuite/tests/backpack/cabal/bkpcabal07/bkpcabal07.cabal

+name:                bkpcabal06
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=2.0
+
+library indef
+  signatures: P
+  reexported-modules: Prelude
+  build-depends: base
+  default-language: Haskell2010
+
+library
+  exposed-modules: M
+  build-depends: indef, base
+  mixins: base (Prelude as P)
+  default-language: Haskell2010