Commit 00b8f8c5 authored by Edward Z. Yang's avatar Edward Z. Yang

Refactor package state, also fixing a module reexport bug.

Instead of building a multiply indirected data structure and querying
it on every import, we now have two data structures moduleToPkgConf
and moduleToPkgConfAll.  moduleToPkgConf is a single-level UniqFM that
is intended to be used for most valid imports; however, it does not
contain any information useful for error reporting.  If an error is
occurred, we then query moduleToPkgConfAll, which contains a more
comprehensive view of the package database.  This field is lazily
initialized (so this means we're retaining the package database list,
but this should be fine because we're already maintaining the entries
of the list.)  Additionally, the full view doesn't keep track of a boolean
toggle for visibility/exposure anymore, but instead tracks the *provenance*
of how the module binding came to be (the ModuleOrigin data type).

Additionally, we move the logic for determining if a module is exposed
or not from Finder.lhs and put it in Packages.lhs; this information is
communicated via the LookupResult data type.  Unfortunately, we can't
directly return a FindResult, because this data type is defined in
HscTypes which depends on Packages.  This is going to change some more
in the near future when I add thinning/renaming to package flags; the
error messages will need to be more flexible.

I've also slightly changed the semantics of error messages for package
qualified imports.  Previously, if we didn't find any package qualified
imports, but there were hidden modules in a *different* package, the error
message would prefer mentioning those as opposed to providing suggestions.
Now, if a module is hidden but in the wrong package, we won't mention it;
instead, it will get mentioned with the other module suggestions.  I
was too lazy to write a test, but I can add one if people would like.

The module reexport bug was, package q reexported p:P as Conflict,
and package r reexported p:P2 as Conflict, this was *not* reported as
a conflict, because the old logic incorrectly decided that P and P2 were
the same module on account of being from the same package.  The logic here
has been corrected.

Contains haddock submodule update.
Signed-off-by: default avatarEdward Z. Yang <>
parent de3f0644
......@@ -43,7 +43,6 @@ import Maybes ( expectJust )
import Exception ( evaluate )
import Distribution.Text
import Distribution.Package hiding (PackageKey, mkPackageKey)
import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef )
import System.Directory
import System.FilePath
......@@ -190,46 +189,21 @@ homeSearchCache hsc_env mod_name do_this = do
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
-- not found in any package:
= case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of
Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_suggestions = suggest })
Right found'
| null found_visible -- Found, but with no exposed copies
-> return (NotFound { fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = pkg_hiddens
, fr_mods_hidden = mod_hiddens
, fr_suggestions = [] })
| [ModConf mod_name' pkg_conf _ _] <- found_visible -- Found uniquely
-> let pkgid = packageConfigId pkg_conf in
findPackageModule_ hsc_env (mkModule pkgid mod_name') pkg_conf
| otherwise -- Found in more than one place
-> return (FoundMultiple (map (packageConfigId.modConfPkg)
found = eltsUFM found'
for_this_pkg = case mb_pkg of
Nothing -> found
Just p -> filter ((`matches` p).modConfPkg) found
found_visible = filter modConfVisible for_this_pkg
-- NB: _vis is guaranteed to be False; a non-exposed module
-- can never be visible.
mod_hiddens = [ packageConfigId pkg_conf
| ModConf _ pkg_conf False _vis <- found ]
-- NB: We /re-report/ non-exposed modules of hidden packages.
pkg_hiddens = [ packageConfigId pkg_conf
| ModConf _ pkg_conf _ False <- found
, not (exposed pkg_conf) ]
pkg_conf `matches` pkg
= case packageName pkg_conf of
PackageName n -> pkg == mkFastString n
= case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
LookupFound m pkg_conf ->
findPackageModule_ hsc_env m pkg_conf
LookupMultiple rs ->
return (FoundMultiple (map (packageConfigId . snd) rs))
LookupHidden pkg_hiddens mod_hiddens ->
return (NotFound { fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = map (packageConfigId.snd) pkg_hiddens
, fr_mods_hidden = map (packageConfigId.snd) mod_hiddens
, fr_suggestions = [] })
LookupNotFound suggest ->
return (NotFound { fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_suggestions = suggest })
modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
modLocationCache hsc_env mod do_this = do
......@@ -555,7 +529,7 @@ cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
sep [ptext (sLit "it was found in multiple packages:"),
hsep (map (text.packageKeyString) pkgs)]
hsep (map ppr pkgs)]
cantFindErr cannot_find _ dflags mod_name find_result
= ptext cannot_find <+> quotes (ppr mod_name)
......@@ -1471,15 +1471,14 @@ mkQualModule :: DynFlags -> QueryQualifyModule
mkQualModule dflags mod
| modulePackageKey mod == thisPackage dflags = False
| [pkgconfig] <- [modConfPkg m | m <- lookup
, modConfVisible m ],
| [(_, pkgconfig)] <- lookup,
packageConfigId pkgconfig == modulePackageKey mod
-- this says: we are given a module P:M, is there just one exposed package
-- that exposes a module M, and is it package P?
= False
| otherwise = True
where lookup = eltsUFM $ lookupModuleInAllPackages dflags (moduleName mod)
where lookup = lookupModuleInAllPackages dflags (moduleName mod)
-- | Creates a function for formatting packages based on two heuristics:
-- (1) don't qualify if the package in question is "main", and (2) only qualify
This diff is collapsed.
......@@ -58,6 +58,9 @@ cabal05: clean
cd s && $(SETUP) clean
cd s && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
cd s && $(SETUP) build
cd t && $(SETUP) clean
cd t && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
! (cd t && $(SETUP) build)
ifneq "$(CLEANUP)" ""
$(MAKE) clean
......@@ -66,4 +69,4 @@ clean :
'$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
'$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
'$(GHC_PKG)' unregister --force r >/dev/null 2>&1 || true
$(RM) -r p-* q-* r-* tmp.d *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
$(RM) -r p-* q-* r-* s-* t-* tmp.d *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
......@@ -25,5 +25,6 @@ library
-- qualified=NO, where=SELF, renaming=YES, conflict=NO
Q as QQ,
-- qualified=NO, where=SELF, renaming=YES, conflict=YES (r)
Q as QMerge
Q as QMerge,
P2 as Conflict
build-depends: base, p
......@@ -14,7 +14,7 @@ library
-- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=NO
P as RP2,
-- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=YES
P2 as PMerge,
P as PMerge,
-- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=NO
p:P as RP,
-- qualified=YES, where=DEP(REEX), renaming=YES, conflict=NO
......@@ -28,5 +28,6 @@ library
-- qualified=YES, where=DEP, renaming=NO, conflict=YES (q)
-- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=YES (q)
p:P2 as PMerge2
p:P2 as PMerge2,
P as Conflict
build-depends: base, p, q
import Distribution.Simple
main = defaultMain
module T where
import Conflict -- should be ambiguous
name: t
license-file: LICENSE
author: Edward Z. Yang
build-type: Simple
cabal-version: >=1.21
exposed-modules: T
build-depends: base, q, r
Subproject commit b99b57c0df072d12b67816b45eca2a03cb1da96d
Subproject commit d59fec2c9551b5662a3507c0011e32a09a9c118f
Markdown is supported
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment