Commit 852a43f3 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Correctly handle wired in unit IDs in -instantiated-with

To handle wired in packages, we must rewrite all occurrences
of unit ids like base- 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: default avatarEdward Z. Yang <>

Test Plan: validate

Reviewers: bgamari, austin

Subscribers: rwbarton, thomie

Differential Revision:
parent 45d33f35
......@@ -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 },
-- -----------------------------------------------------------------------------
......@@ -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),
= 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- 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
......@@ -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.
include $(TOP)/mk/
include $(TOP)/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
$(SETUP) build
ifneq "$(CLEANUP)" ""
$(MAKE) -s --no-print-directory clean
clean :
$(RM) -rf tmp.d inst dist Setup$(exeext)
import Distribution.Simple
main = defaultMain
if config.cleanup:
cleanup = 'CLEANUP=1'
cleanup = 'CLEANUP=0'
extra_files(['bkpcabal07.cabal', 'Setup.hs', 'M.hs', 'P.hsig']),
['$MAKE -s --no-print-directory bkpcabal07 ' + cleanup])
name: bkpcabal06
license: BSD3
author: Edward Z. Yang
build-type: Simple
cabal-version: >=2.0
library indef
signatures: P
reexported-modules: Prelude
build-depends: base
default-language: Haskell2010
exposed-modules: M
build-depends: indef, base
mixins: base (Prelude as P)
default-language: Haskell2010
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment