summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdward Z. Yang <ezyang@cs.stanford.edu>2015-09-11 17:13:30 -0700
committerEdward Z. Yang <ezyang@cs.stanford.edu>2015-09-21 11:11:48 -0700
commit3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b (patch)
tree0beb42ce43328983d54718bf835e82ea48c8d2db
parentc234acbe76da85556befad3eaa0c7c6b31e9e1c3 (diff)
downloadhaskell-3f13c20e0c29d3db974c2a0d7d5ec15abd5a434b.tar.gz
Revert "Revert "Revert "Support for multiple signature files in scope."""
This reverts commit 214596de224afa576a9c295bcf53c6941d6892e0.
-rw-r--r--compiler/deSugar/DsMonad.hs2
-rw-r--r--compiler/ghci/Linker.hs46
-rw-r--r--compiler/iface/LoadIface.hs18
-rw-r--r--compiler/iface/MkIface.hs18
-rw-r--r--compiler/main/DriverMkDepend.hs5
-rw-r--r--compiler/main/DynamicLoading.hs21
-rw-r--r--compiler/main/Finder.hs77
-rw-r--r--compiler/main/GHC.hs30
-rw-r--r--compiler/main/GhcMake.hs19
-rw-r--r--compiler/main/HscTypes.hs36
-rw-r--r--compiler/main/Packages.hs214
-rw-r--r--docs/users_guide/separate_compilation.xml5
-rw-r--r--ghc/Main.hs5
-rw-r--r--testsuite/.gitignore6
-rw-r--r--testsuite/tests/cabal/sigcabal02/Main.hs7
-rw-r--r--testsuite/tests/cabal/sigcabal02/Makefile34
-rw-r--r--testsuite/tests/cabal/sigcabal02/Setup.hs2
-rw-r--r--testsuite/tests/cabal/sigcabal02/ShouldFail.hs1
-rw-r--r--testsuite/tests/cabal/sigcabal02/all.T9
-rw-r--r--testsuite/tests/cabal/sigcabal02/p/LICENSE0
-rw-r--r--testsuite/tests/cabal/sigcabal02/p/Map.hsig18
-rw-r--r--testsuite/tests/cabal/sigcabal02/p/P.hs12
-rw-r--r--testsuite/tests/cabal/sigcabal02/p/Set.hsig13
-rw-r--r--testsuite/tests/cabal/sigcabal02/p/p.cabal14
-rw-r--r--testsuite/tests/cabal/sigcabal02/q/LICENSE0
-rw-r--r--testsuite/tests/cabal/sigcabal02/q/Map.hsig7
-rw-r--r--testsuite/tests/cabal/sigcabal02/q/Q.hs7
-rw-r--r--testsuite/tests/cabal/sigcabal02/q/q.cabal13
-rw-r--r--testsuite/tests/cabal/sigcabal02/sigcabal02.stderr4
-rw-r--r--testsuite/tests/cabal/sigcabal02/sigcabal02.stdout5
-rw-r--r--testsuite/tests/driver/recomp014/Makefile31
-rw-r--r--testsuite/tests/driver/recomp014/all.T4
-rw-r--r--testsuite/tests/driver/recomp014/recomp014.stdout4
-rw-r--r--testsuite/tests/driver/sigof01/Makefile6
-rw-r--r--testsuite/tests/driver/sigof01/all.T10
-rw-r--r--testsuite/tests/driver/sigof01/sigof01i.script1
-rw-r--r--testsuite/tests/driver/sigof01/sigof01i.stdout3
-rw-r--r--testsuite/tests/driver/sigof01/sigof01i2.script3
-rw-r--r--testsuite/tests/driver/sigof01/sigof01i2.stdout9
-rw-r--r--testsuite/tests/package/package09e.stderr2
40 files changed, 139 insertions, 582 deletions
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs
index ad6a6b1d7b..61beca2f5c 100644
--- a/compiler/deSugar/DsMonad.hs
+++ b/compiler/deSugar/DsMonad.hs
@@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
else do {
; result <- liftIO $ findImportedModule hsc_env modname Nothing
; case result of
- FoundModule h -> loadModule err (fr_mod h)
+ Found _ mod -> loadModule err mod
_ -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err
} }
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index c5fe7139fc..8c2a07c07f 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -562,29 +562,23 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
-- 3. For each dependent module, find its linkable
-- This will either be in the HPT or (in the case of one-shot
- -- compilation) we may need to use maybe_getFileLinkable.
- -- If the module is actually a signature, there won't be a
- -- linkable (thus catMaybes)
+ -- compilation) we may need to use maybe_getFileLinkable
; let { osuf = objectSuf dflags }
- ; lnks_needed <- fmap Maybes.catMaybes
- $ mapM (get_linkable osuf) mods_needed
+ ; lnks_needed <- mapM (get_linkable osuf) mods_needed
; return (lnks_needed, pkgs_needed) }
where
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
- -- | Given a list of modules @mods@, recursively discover all external
- -- package and local module (according to @this_pkg@) dependencies.
- --
- -- The 'ModIface' contains the transitive closure of the module dependencies
- -- within the current package, *except* for boot modules: if we encounter
- -- a boot module, we have to find its real interface and discover the
- -- dependencies of that. Hence we need to traverse the dependency
- -- tree recursively. See bug #936, testcase ghci/prog007.
- follow_deps :: [Module] -- modules to follow
- -> UniqSet ModuleName -- accum. module dependencies
- -> UniqSet PackageKey -- accum. package dependencies
+ -- The ModIface contains the transitive closure of the module dependencies
+ -- within the current package, *except* for boot modules: if we encounter
+ -- a boot module, we have to find its real interface and discover the
+ -- dependencies of that. Hence we need to traverse the dependency
+ -- tree recursively. See bug #936, testcase ghci/prog007.
+ follow_deps :: [Module] -- modules to follow
+ -> UniqSet ModuleName -- accum. module dependencies
+ -> UniqSet PackageKey -- accum. package dependencies
-> IO ([ModuleName], [PackageKey]) -- result
follow_deps [] acc_mods acc_pkgs
= return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
@@ -607,7 +601,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
where is_boot (m,True) = Left m
is_boot (m,False) = Right m
- -- Boot module dependencies which must be processed recursively
boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps)
acc_pkgs' = addListToUniqSet acc_pkgs $ map fst pkg_deps
@@ -638,37 +631,30 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
get_linkable osuf mod_name -- A home-package module
| Just mod_info <- lookupUFM hpt mod_name
- = adjust_linkable (hm_iface mod_info)
- (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
+ = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
| otherwise
= do -- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation...
- -- ezyang: I don't actually know how to trigger this codepath,
- -- seeing as this is GHCi logic. Template Haskell, maybe?
mb_stuff <- findHomeModule hsc_env mod_name
case mb_stuff of
- FoundExact loc mod -> found loc mod
+ Found loc mod -> found loc mod
_ -> no_obj mod_name
where
found loc mod = do {
-- ...and then find the linkable for it
mb_lnk <- findObjectLinkableMaybe mod loc ;
- iface <- initIfaceCheck hsc_env $
- loadUserInterface False (text "getLinkDeps2") mod ;
case mb_lnk of {
Nothing -> no_obj mod ;
- Just lnk -> adjust_linkable iface lnk
+ Just lnk -> adjust_linkable lnk
}}
- adjust_linkable iface lnk
- -- Signatures have no linkables! Don't return one.
- | mi_hsc_src iface == HsigFile = return Nothing
+ adjust_linkable lnk
| Just new_osuf <- replace_osuf = do
new_uls <- mapM (adjust_ul new_osuf)
(linkableUnlinked lnk)
- return (Just lnk{ linkableUnlinked=new_uls })
+ return lnk{ linkableUnlinked=new_uls }
| otherwise =
- return (Just lnk)
+ return lnk
adjust_ul new_osuf (DotO file) = do
MASSERT(osuf `isSuffixOf` file)
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 60e3a8a446..68143f959b 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -298,17 +298,12 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
= do { hsc_env <- getTopEnv
+ -- ToDo: findImportedModule should return a list of interfaces
; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
; case res of
- FoundModule (FoundHs { fr_mod = mod })
- -> fmap (fmap (:[]))
- . initIfaceTcRn
- $ loadInterface doc mod (ImportByUser want_boot)
- FoundSigs mods _backing
- -> initIfaceTcRn $ do
- ms <- forM mods $ \(FoundHs { fr_mod = mod }) ->
- loadInterface doc mod (ImportByUser want_boot)
- return (sequence ms)
+ Found _ mod -> fmap (fmap (:[]))
+ . initIfaceTcRn
+ $ loadInterface doc mod (ImportByUser want_boot)
err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
-- | Load interface directly for a fully qualified 'Module'. (This is a fairly
@@ -746,7 +741,7 @@ findAndReadIface doc_str mod hi_boot_file
hsc_env <- getTopEnv
mb_found <- liftIO (findExactModule hsc_env mod)
case mb_found of
- FoundExact loc mod -> do
+ Found loc mod -> do
-- Found file, so read it
let file_path = addBootSuffix_maybe hi_boot_file
@@ -763,8 +758,7 @@ findAndReadIface doc_str mod hi_boot_file
traceIf (ptext (sLit "...not found"))
dflags <- getDynFlags
return (Failed (cannotFindInterface dflags
- (moduleName mod)
- (convFindExactResult err)))
+ (moduleName mod) err))
where read_file file_path = do
traceIf (ptext (sLit "readIFace") <+> text file_path)
read_result <- readIface mod file_path
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index a095ec84d2..757bebac93 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1334,20 +1334,9 @@ checkDependencies hsc_env summary iface
find_res <- liftIO $ findImportedModule hsc_env mod (fmap sl_fs pkg)
let reason = moduleNameString mod ++ " changed"
case find_res of
- FoundModule h -> check_mod reason (fr_mod h)
- FoundSigs hs _backing -> check_mods reason (map fr_mod hs)
- _otherwise -> return (RecompBecause reason)
-
- check_mods _ [] = return UpToDate
- check_mods reason (m:ms) = do
- r <- check_mod reason m
- case r of
- UpToDate -> check_mods reason ms
- _otherwise -> return r
-
- check_mod reason mod
+ Found _ mod
| pkg == this_pkg
- = if moduleName mod `notElem` map fst prev_dep_mods
+ -> if moduleName mod `notElem` map fst prev_dep_mods
then do traceHiDiffs $
text "imported module " <> quotes (ppr mod) <>
text " not among previous dependencies"
@@ -1355,7 +1344,7 @@ checkDependencies hsc_env summary iface
else
return UpToDate
| otherwise
- = if pkg `notElem` (map fst prev_dep_pkgs)
+ -> if pkg `notElem` (map fst prev_dep_pkgs)
then do traceHiDiffs $
text "imported module " <> quotes (ppr mod) <>
text " is from package " <> quotes (ppr pkg) <>
@@ -1364,6 +1353,7 @@ checkDependencies hsc_env summary iface
else
return UpToDate
where pkg = modulePackageKey mod
+ _otherwise -> return (RecompBecause reason)
needInterface :: Module -> (ModIface -> IfG RecompileRequired)
-> IfG RecompileRequired
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index 026afc6eb6..4d2aadca90 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -249,7 +249,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
-- we've done it once during downsweep
r <- findImportedModule hsc_env imp pkg
; case r of
- FoundModule (FoundHs { fr_loc = loc })
+ Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
-> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
@@ -258,9 +258,6 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
| otherwise
-> return Nothing
- -- TODO: FoundSignature. For now, we assume home package
- -- "signature" dependencies look like FoundModule.
-
fail ->
let dflags = hsc_dflags hsc_env
in throwOneError $ mkPlainErrMsg dflags srcloc $
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index 3b62717a9c..0d72bece36 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -203,15 +203,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- First find the package the module resides in by searching exposed packages and home modules
found_module <- findImportedModule hsc_env mod_name Nothing
case found_module of
- FoundModule h -> check_mod (fr_mod h)
- FoundSigs hs _backing -> check_mods (map fr_mod hs) -- (not tested)
- err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
- where
- dflags = hsc_dflags hsc_env
- meth = "lookupRdrNameInModule"
- doc = ptext (sLit $ "contains a name used in an invocation of " ++ meth)
-
- check_mod mod = do
+ Found _ mod -> do
-- Find the exports of the module
(_, mb_iface) <- initTcInteractive hsc_env $
initIfaceTcRn $
@@ -229,13 +221,10 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
_ -> panic "lookupRdrNameInModule"
Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
-
- check_mods [] = return Nothing
- check_mods (m:ms) = do
- r <- check_mod m
- case r of
- Nothing -> check_mods ms
- Just _ -> return r
+ err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
+ where
+ dflags = hsc_dflags hsc_env
+ doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule")
wrongTyThingError :: Name -> TyThing -> SDoc
wrongTyThingError name got_thing = hsep [ptext (sLit "The name"), ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index d8aef57011..00ba0388dd 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -9,7 +9,6 @@
module Finder (
flushFinderCaches,
FindResult(..),
- convFindExactResult, -- move to HscTypes?
findImportedModule,
findExactModule,
findHomeModule,
@@ -46,7 +45,8 @@ import System.Directory
import System.FilePath
import Control.Monad
import Data.Time
-import Data.List ( foldl', partition )
+import Data.List ( foldl' )
+
type FileExt = String -- Filename extension
type BaseName = String -- Basename of file
@@ -75,7 +75,7 @@ flushFinderCaches hsc_env =
is_ext mod _ | modulePackageKey mod /= this_pkg = True
| otherwise = False
-addToFinderCache :: IORef FinderCache -> Module -> FindExactResult -> IO ()
+addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO ()
addToFinderCache ref key val =
atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ())
@@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
removeFromFinderCache ref key =
atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ())
-lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindExactResult)
+lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindResult)
lookupFinderCache ref key = do
c <- readIORef ref
return $! lookupModuleEnv c key
@@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg =
Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
| otherwise -> pkg_import
where
- home_import = convFindExactResult `fmap` findHomeModule hsc_env mod_name
+ home_import = findHomeModule hsc_env mod_name
pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
@@ -118,7 +118,7 @@ findImportedModule hsc_env mod_name mb_pkg =
-- reading the interface for a module mentioned by another interface,
-- for example (a "system import").
-findExactModule :: HscEnv -> Module -> IO FindExactResult
+findExactModule :: HscEnv -> Module -> IO FindResult
findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env
in if modulePackageKey mod == thisPackage dflags
@@ -152,45 +152,17 @@ orIfNotFound this or_this = do
-- been done. Otherwise, do the lookup (with the IO action) and save
-- the result in the finder cache and the module location cache (if it
-- was successful.)
-homeSearchCache :: HscEnv
- -> ModuleName
- -> IO FindExactResult
- -> IO FindExactResult
+homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
homeSearchCache hsc_env mod_name do_this = do
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
modLocationCache hsc_env mod do_this
--- | Converts a 'FindExactResult' into a 'FindResult' in the obvious way.
-convFindExactResult :: FindExactResult -> FindResult
-convFindExactResult (FoundExact loc m) = FoundModule (FoundHs loc m)
-convFindExactResult (NoPackageExact pk) = NoPackage pk
-convFindExactResult NotFoundExact { fer_paths = paths, fer_pkg = pkg } =
- NotFound {
- fr_paths = paths, fr_pkg = pkg,
- fr_pkgs_hidden = [], fr_mods_hidden = [], fr_suggestions = []
- }
-
-foundExact :: FindExactResult -> Bool
-foundExact FoundExact{} = True
-foundExact _ = False
-
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg
= case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
- LookupFound (m, _) -> do
- fmap convFindExactResult (findPackageModule hsc_env m)
- LookupFoundSigs ms backing -> do
- locs <- mapM (findPackageModule hsc_env . fst) ms
- let (ok, missing) = partition foundExact locs
- case missing of
- -- At the moment, we return the errors one at a time. It might be
- -- better if we collected them up and reported them all, but
- -- FindResult doesn't have enough information to support this.
- -- In any case, this REALLY shouldn't happen (it means there are
- -- broken packages in the database.)
- (m:_) -> return (convFindExactResult m)
- _ -> return (FoundSigs [FoundHs l m | FoundExact l m <- ok] backing)
+ LookupFound m pkg_conf ->
+ findPackageModule_ hsc_env m pkg_conf
LookupMultiple rs ->
return (FoundMultiple rs)
LookupHidden pkg_hiddens mod_hiddens ->
@@ -204,7 +176,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg
, fr_mods_hidden = []
, fr_suggestions = suggest })
-modLocationCache :: HscEnv -> Module -> IO FindExactResult -> IO FindExactResult
+modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
modLocationCache hsc_env mod do_this = do
m <- lookupFinderCache (hsc_FC hsc_env) mod
case m of
@@ -217,7 +189,7 @@ modLocationCache hsc_env mod do_this = do
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
- addToFinderCache (hsc_FC hsc_env) mod (FoundExact loc mod)
+ addToFinderCache (hsc_FC hsc_env) mod (Found loc mod)
return mod
uncacheModule :: HscEnv -> ModuleName -> IO ()
@@ -244,7 +216,7 @@ uncacheModule hsc_env mod = do
--
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.)
-findHomeModule :: HscEnv -> ModuleName -> IO FindExactResult
+findHomeModule :: HscEnv -> ModuleName -> IO FindResult
findHomeModule hsc_env mod_name =
homeSearchCache hsc_env mod_name $
let
@@ -275,19 +247,19 @@ findHomeModule hsc_env mod_name =
-- This is important only when compiling the base package (where GHC.Prim
-- is a home module).
if mod == gHC_PRIM
- then return (FoundExact (error "GHC.Prim ModLocation") mod)
+ then return (Found (error "GHC.Prim ModLocation") mod)
else searchPathExts home_path mod exts
-- | Search for a module in external packages only.
-findPackageModule :: HscEnv -> Module -> IO FindExactResult
+findPackageModule :: HscEnv -> Module -> IO FindResult
findPackageModule hsc_env mod = do
let
dflags = hsc_dflags hsc_env
pkg_id = modulePackageKey mod
--
case lookupPackage dflags pkg_id of
- Nothing -> return (NoPackageExact pkg_id)
+ Nothing -> return (NoPackage pkg_id)
Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
-- | Look up the interface file associated with module @mod@. This function
@@ -297,14 +269,14 @@ findPackageModule hsc_env mod = do
-- the 'PackageConfig' must be consistent with the package key in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
-findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindExactResult
+findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
findPackageModule_ hsc_env mod pkg_conf =
ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
modLocationCache hsc_env mod $
-- special case for GHC.Prim; we won't find it in the filesystem.
if mod == gHC_PRIM
- then return (FoundExact (error "GHC.Prim ModLocation") mod)
+ then return (Found (error "GHC.Prim ModLocation") mod)
else
let
@@ -327,7 +299,7 @@ findPackageModule_ hsc_env mod pkg_conf =
-- don't bother looking for it.
let basename = moduleNameSlashes (moduleName mod)
loc <- mk_hi_loc one basename
- return (FoundExact loc mod)
+ return (Found loc mod)
_otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
@@ -342,7 +314,7 @@ searchPathExts
FilePath -> BaseName -> IO ModLocation -- action
)
]
- -> IO FindExactResult
+ -> IO FindResult
searchPathExts paths mod exts
= do result <- search to_search
@@ -368,13 +340,15 @@ searchPathExts paths mod exts
file = base <.> ext
]
- search [] = return (NotFoundExact {fer_paths = map fst to_search
- ,fer_pkg = Just (modulePackageKey mod)})
+ search [] = return (NotFound { fr_paths = map fst to_search
+ , fr_pkg = Just (modulePackageKey mod)
+ , fr_mods_hidden = [], fr_pkgs_hidden = []
+ , fr_suggestions = [] })
search ((file, mk_result) : rest) = do
b <- doesFileExist file
if b
- then do { loc <- mk_result; return (FoundExact loc mod) }
+ then do { loc <- mk_result; return (Found loc mod) }
else search rest
mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
@@ -597,8 +571,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
vcat (map mod_hidden mod_hiddens) $$
tried_these files
- _ -> pprPanic "cantFindErr"
- (ptext cannot_find <+> quotes (ppr mod_name))
+ _ -> panic "cantFindErr"
build_tag = buildTag dflags
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f6c1cecf92..591d569c41 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1361,20 +1361,6 @@ showRichTokenStream ts = go startLoc ts ""
-- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the
-- filesystem and package database to find the corresponding 'Module',
-- using the algorithm that is used for an @import@ declaration.
---
--- However, there is a twist for local modules, see #2682.
---
--- The full algorithm:
--- IF it's a package qualified import for a REMOTE package (not @this_pkg@ or
--- this), do a normal lookup.
--- OTHERWISE see if it is ALREADY loaded, and use it if it is.
--- OTHERWISE do a normal lookup, but reject the result if the found result
--- is from the LOCAL package (@this_pkg@).
---
--- For signatures, we return the BACKING implementation to keep the API
--- consistent with what we had before. (ToDo: create a new GHC API which
--- can deal with signatures.)
---
findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
let
@@ -1385,23 +1371,17 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
- FoundModule h -> return (fr_mod h)
- FoundSigs _ backing -> return backing
+ Found _ m -> return m
err -> throwOneError $ noModError dflags noSrcSpan mod_name err
_otherwise -> do
home <- lookupLoadedHomeModule mod_name
case home of
- -- TODO: This COULD be a signature
Just m -> return m
Nothing -> liftIO $ do
res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
- FoundModule (FoundHs { fr_mod = m, fr_loc = loc })
- | modulePackageKey m /= this_pkg -> return m
- | otherwise -> modNotLoadedError dflags m loc
- FoundSigs (FoundHs { fr_loc = loc, fr_mod = m }:_) backing
- | modulePackageKey m /= this_pkg -> return backing
- | otherwise -> modNotLoadedError dflags m loc
+ Found loc m | modulePackageKey m /= this_pkg -> return m
+ | otherwise -> modNotLoadedError dflags m loc
err -> throwOneError $ noModError dflags noSrcSpan mod_name err
modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a
@@ -1422,13 +1402,11 @@ lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
lookupModule mod_name Nothing = withSession $ \hsc_env -> do
home <- lookupLoadedHomeModule mod_name
case home of
- -- TODO: This COULD be a signature
Just m -> return m
Nothing -> liftIO $ do
res <- findExposedPackageModule hsc_env mod_name Nothing
case res of
- FoundModule (FoundHs { fr_mod = m }) -> return m
- FoundSigs _ backing -> return backing
+ Found _ m -> return m
err -> throwOneError $ noModError (hsc_dflags hsc_env) noSrcSpan mod_name err
lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 2ea3816f94..715b4503ef 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1818,10 +1818,7 @@ findSummaryBySourceFile summaries file
[] -> Nothing
(x:_) -> Just x
--- | Summarise a module, and pick up source and timestamp.
--- Returns @Nothing@ if the module is excluded via @excl_mods@ or is an
--- external package module (which we don't compile), otherwise returns the
--- new module summary (or an error saying why we couldn't summarise it).
+-- Summarise a module, and pick up source and timestamp.
summariseModule
:: HscEnv
-> NodeMap ModSummary -- Map of old summaries
@@ -1883,10 +1880,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
uncacheModule hsc_env wanted_mod
found <- findImportedModule hsc_env wanted_mod Nothing
case found of
- -- TODO: When we add -alias support, we can validly find
- -- multiple signatures in the home package; need to make this
- -- logic more flexible in that case.
- FoundModule (FoundHs { fr_loc = location, fr_mod = mod })
+ Found location mod
| isJust (ml_hs_file location) ->
-- Home package
just_found location mod
@@ -1895,15 +1889,6 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
ASSERT(modulePackageKey mod /= thisPackage dflags)
return Nothing
- FoundSigs hs _backing
- | Just (FoundHs { fr_loc = location, fr_mod = mod })
- <- find (isJust . ml_hs_file . fr_loc) hs ->
- just_found location mod
- | otherwise ->
- ASSERT(all (\h -> modulePackageKey (fr_mod h)
- /= thisPackage dflags) hs)
- return Nothing
-
err -> return $ Just $ Left $ noModError dflags loc wanted_mod err
-- Not found
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 3b47e4c00a..6b94998490 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -10,7 +10,7 @@
module HscTypes (
-- * compilation state
HscEnv(..), hscEPS,
- FinderCache, FindResult(..), FoundHs(..), FindExactResult(..),
+ FinderCache, FindResult(..),
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
HscStatus(..),
@@ -674,30 +674,15 @@ prepareAnnotations hsc_env mb_guts = do
-- modules along the search path. On @:load@, we flush the entire
-- contents of this cache.
--
-type FinderCache = ModuleEnv FindExactResult
-
--- | The result of search for an exact 'Module'.
-data FindExactResult
- = FoundExact ModLocation Module
- -- ^ The module/signature was found
- | NoPackageExact PackageKey
- | NotFoundExact
- { fer_paths :: [FilePath]
- , fer_pkg :: Maybe PackageKey
- }
-
--- | A found module or signature; e.g. anything with an interface file
-data FoundHs = FoundHs { fr_loc :: ModLocation
- , fr_mod :: Module
- -- , fr_origin :: ModuleOrigin
- }
+-- Although the @FinderCache@ range is 'FindResult' for convenience,
+-- in fact it will only ever contain 'Found' or 'NotFound' entries.
+--
+type FinderCache = ModuleEnv FindResult
-- | The result of searching for an imported module.
data FindResult
- = FoundModule FoundHs
+ = Found ModLocation Module
-- ^ The module was found
- | FoundSigs [FoundHs] Module
- -- ^ Signatures were found, with some backing implementation
| NoPackage PackageKey
-- ^ The requested package was not found
| FoundMultiple [(Module, ModuleOrigin)]
@@ -2093,15 +2078,6 @@ type IsBootInterface = Bool
-- Invariant: the dependencies of a module @M@ never includes @M@.
--
-- Invariant: none of the lists contain duplicates.
---
--- NB: While this contains information about all modules and packages below
--- this one in the the import *hierarchy*, this may not accurately reflect
--- the full runtime dependencies of the module. This is because this module may
--- have imported a boot module, in which case we'll only have recorded the
--- dependencies from the hs-boot file, not the actual hs file. (This is
--- unavoidable: usually, the actual hs file will have been compiled *after*
--- we wrote this interface file.) See #936, and also @getLinkDeps@ in
--- @compiler/ghci/Linker.hs@ for code which cares about this distinction.
data Dependencies
= Deps { dep_mods :: [(ModuleName, IsBootInterface)]
-- ^ All home-package modules transitively below this one
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 20822476cd..bb0aba241e 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -132,10 +132,9 @@ import qualified Data.Set as Set
-- in a different DLL, by setting the DLL flag.
-- | Given a module name, there may be multiple ways it came into scope,
--- possibly simultaneously. For a given particular implementation (e.g.
--- original module, or even a signature module), this data type tracks all the
--- possible ways it could have come into scope. Warning: don't use the record
--- functions, they're partial!
+-- possibly simultaneously. This data type tracks all the possible ways
+-- it could have come into scope. Warning: don't use the record functions,
+-- they're partial!
data ModuleOrigin =
-- | Module is hidden, and thus never will be available for import.
-- (But maybe the user didn't realize), so we'll still keep track
@@ -159,7 +158,7 @@ data ModuleOrigin =
}
instance Outputable ModuleOrigin where
- ppr ModHidden = text "hidden module" -- NB: cannot be signature
+ ppr ModHidden = text "hidden module"
ppr (ModOrigin e res rhs f) = sep (punctuate comma (
(case e of
Nothing -> []
@@ -176,18 +175,17 @@ instance Outputable ModuleOrigin where
(if f then [text "package flag"] else [])
))
--- | Smart constructor for a module which is in @exposed-modules@ or
--- @exposed-signatures@. Takes as an argument whether or not the defining
--- package is exposed.
-fromExposed :: Bool -> ModuleOrigin
-fromExposed e = ModOrigin (Just e) [] [] False
+-- | Smart constructor for a module which is in @exposed-modules@. Takes
+-- as an argument whether or not the defining package is exposed.
+fromExposedModules :: Bool -> ModuleOrigin
+fromExposedModules e = ModOrigin (Just e) [] [] False
--- | Smart constructor for a module which is in @reexported-modules@
--- or @reexported-signatures@. Takes as an argument whether or not the
--- reexporting package is expsed, and also its 'PackageConfig'.
-fromReexported :: Bool -> PackageConfig -> ModuleOrigin
-fromReexported True pkg = ModOrigin Nothing [pkg] [] False
-fromReexported False pkg = ModOrigin Nothing [] [pkg] False
+-- | Smart constructor for a module which is in @reexported-modules@. Takes
+-- as an argument whether or not the reexporting package is expsed, and
+-- also its 'PackageConfig'.
+fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin
+fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False
+fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False
-- | Smart constructor for a module which was bound by a package flag.
fromFlag :: ModuleOrigin
@@ -229,40 +227,11 @@ type PackageConfigMap = PackageKeyMap PackageConfig
type VisibilityMap =
PackageKeyMap (Bool, [(ModuleName, ModuleName)], FastString)
--- | Alias for 'Module' indicating we expect the interface in question to
--- be for a signature.
-type Signature = Module
-
--- | Alias for 'ModuleOrigin' indicating we expect it to describe a signature.
-type SignatureOrigin = ModuleOrigin
-
--- | This is the main lookup structure we use to handle imports, which map
--- from 'ModuleName' to 'ModuleDb', which describes all possible implementations
--- which are available under a module name.
-type ModuleNameDb = Map ModuleName ModuleDb
-
--- | This is an auxiliary structure per module name, and it's a map of
--- backing implementations to more information about them. This is a map
--- so it's easy to tell if we're bringing in an implementation for a name
--- which is already in scope (and thus non-conflicting.)
-type ModuleDb = Map Module ModuleDesc
-
--- | Per backing implementation, there may be multiple signatures available
--- exporting subsets of its interface; we need to track all of them.
-type SignatureDb = Map Signature SignatureOrigin
-
--- | Combined module description for a module: includes 'ModuleOrigin'
--- describing the backing implementation, as well as 'SignatureDb' for any
--- signatures of the module in question.
-data ModuleDesc = MD ModuleOrigin SignatureDb
-
-instance Outputable ModuleDesc where
- ppr (MD o m) = ppr o <+> parens (ppr m)
-
-instance Monoid ModuleDesc where
- mempty = MD mempty Map.empty
- mappend (MD o m) (MD o' m') = MD (o `mappend` o')
- (Map.unionWith mappend m m')
+-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings
+-- in scope. The 'PackageConf' is not cached, mostly for convenience reasons
+-- (since this is the slow path, we'll just look it up again).
+type ModuleToPkgConfAll =
+ Map ModuleName (Map Module ModuleOrigin)
data PackageState = PackageState {
-- | A mapping of 'PackageKey' to 'PackageConfig'. This list is adjusted
@@ -280,7 +249,7 @@ 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.
- moduleNameDb :: ModuleNameDb,
+ moduleToPkgConfAll :: ModuleToPkgConfAll,
-- | This is a map from 'InstalledPackageId' to 'PackageKey', since GHC
-- internally deals in package keys but the database may refer to installed
@@ -292,7 +261,7 @@ emptyPackageState :: PackageState
emptyPackageState = PackageState {
pkgIdMap = emptyUFM,
preloadPackages = [],
- moduleNameDb = Map.empty,
+ moduleToPkgConfAll = Map.empty,
installedPackageIdMap = Map.empty
}
@@ -1058,7 +1027,7 @@ mkPackageState dflags0 pkgs0 preload0 = do
let pstate = PackageState{
preloadPackages = dep_preload,
pkgIdMap = pkg_db,
- moduleNameDb = mkModuleNameDb dflags pkg_db ipid_map vis_map,
+ moduleToPkgConfAll = mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map,
installedPackageIdMap = ipid_map
}
return (pstate, new_dep_preload, this_package)
@@ -1067,70 +1036,62 @@ mkPackageState dflags0 pkgs0 preload0 = do
-- -----------------------------------------------------------------------------
-- | Makes the mapping from module to package info
-mkModuleNameDb
+mkModuleToPkgConfAll
:: DynFlags
-> PackageConfigMap
-> InstalledPackageIdMap
-> VisibilityMap
- -> ModuleNameDb
-mkModuleNameDb dflags pkg_db ipid_map vis_map =
+ -> ModuleToPkgConfAll
+mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map =
foldl' extend_modmap emptyMap (eltsUFM pkg_db)
where
emptyMap = Map.empty
- sing pk m = Map.singleton (mkModule pk m)
+ sing pk m _ = Map.singleton (mkModule pk m)
addListTo = foldl' merge
merge m (k, v) = Map.insertWith (Map.unionWith mappend) k v m
+ setOrigins m os = fmap (const os) m
extend_modmap modmap pkg = addListTo modmap theBindings
where
- theBindings :: [(ModuleName, ModuleDb)]
+ theBindings :: [(ModuleName, Map Module ModuleOrigin)]
theBindings | Just (b,rns,_) <- lookupUFM vis_map (packageConfigId pkg)
= newBindings b rns
| otherwise = newBindings False []
newBindings :: Bool
-> [(ModuleName, ModuleName)]
- -> [(ModuleName, ModuleDb)]
+ -> [(ModuleName, Map Module ModuleOrigin)]
newBindings e rns = es e ++ hiddens ++ map rnBinding rns
rnBinding :: (ModuleName, ModuleName)
- -> (ModuleName, ModuleDb)
- rnBinding (orig, new) = (new, fmap applyFlag origEntry)
+ -> (ModuleName, Map Module ModuleOrigin)
+ rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)
where origEntry = case lookupUFM esmap orig of
Just r -> r
Nothing -> throwGhcException (CmdLineError (showSDoc dflags
(text "package flag: could not find module name" <+>
ppr orig <+> text "in package" <+> ppr pk)))
- applyFlag (MD _ sigs) = MD fromFlag (fmap (const fromFlag) sigs)
-
- es :: Bool -> [(ModuleName, ModuleDb)]
+ es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
es e = do
- ExposedModule m exposedReexport exposedSignature <- exposed_mods
- let (pk', m', origin') =
+ -- TODO: signature support
+ ExposedModule m exposedReexport _exposedSignature <- exposed_mods
+ let (pk', m', pkg', origin') =
case exposedReexport of
- Nothing -> (pk, m, fromExposed e)
+ Nothing -> (pk, m, pkg, fromExposedModules e)
Just (OriginalModule ipid' m') ->
- let (pk', pkg') = ipid_lookup ipid'
- in (pk', m', fromReexported e pkg')
- return $ case exposedSignature of
- Nothing -> (m, sing pk' m' (MD origin' Map.empty))
- Just (OriginalModule ipid'' m'') ->
- let (pk'', _) = ipid_lookup ipid''
- in (m, sing pk'' m'' (MD mempty (sing pk' m' origin')))
+ let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map)
+ pkg' = pkg_lookup pk'
+ in (pk', m', pkg', fromReexportedModules e pkg')
+ return (m, sing pk' m' pkg' origin')
-
- esmap :: UniqFM ModuleDb
+ esmap :: UniqFM (Map Module ModuleOrigin)
esmap = listToUFM (es False) -- parameter here doesn't matter, orig will
-- be overwritten
- hiddens :: [(ModuleName, ModuleDb)]
- hiddens = [(m, sing pk m (MD ModHidden Map.empty)) | m <- hidden_mods]
+ hiddens = [(m, sing pk m pkg ModHidden) | m <- hidden_mods]
pk = packageConfigId pkg
- pkg_lookup = expectJust "mkModuleNameDb" . lookupPackage' pkg_db
- ipid_lookup ipid =
- let pk = expectJust "mkModuleNameDb" (Map.lookup ipid ipid_map)
- in (pk, pkg_lookup pk)
+ pkg_lookup = expectJust "mkModuleToPkgConf" . lookupPackage' pkg_db
exposed_mods = exposedModules pkg
hidden_mods = hiddenModules pkg
@@ -1240,20 +1201,16 @@ lookupModuleInAllPackages :: DynFlags
-> [(Module, PackageConfig)]
lookupModuleInAllPackages dflags m
= case lookupModuleWithSuggestions dflags m Nothing of
- LookupFound (m,_) -> [(m,get_pkg m)]
- LookupMultiple rs -> map (\(m,_) -> (m,get_pkg m)) rs
+ LookupFound a b -> [(a,b)]
+ LookupMultiple rs -> map f rs
+ where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags
+ (modulePackageKey m)))
_ -> []
- where get_pkg = expectJust "lookupModule" . lookupPackage dflags
- . modulePackageKey
-- | The result of performing a lookup
data LookupResult =
-- | Found the module uniquely, nothing else to do
- LookupFound (Module, ModuleOrigin)
- -- | We found (possibly multiple) signatures with a unique backing
- -- implementation: they should be "merged" together. For good measure,
- -- the backing implementation is recorded too.
- | LookupFoundSigs [(Module, ModuleOrigin)] Module
+ LookupFound Module PackageConfig
-- | Multiple modules with the same name in scope
| LookupMultiple [(Module, ModuleOrigin)]
-- | No modules found, but there were some hidden ones with
@@ -1263,39 +1220,6 @@ data LookupResult =
-- | Nothing found, here are some suggested different names
| LookupNotFound [ModuleSuggestion] -- suggestions
-instance Monoid LookupResult where
- mempty = LookupNotFound []
-
- LookupNotFound s1 `mappend` LookupNotFound s2
- = LookupNotFound (s1 ++ s2)
- LookupNotFound{} `mappend` l = l
- l `mappend` LookupNotFound{} = l
-
- LookupHidden x1 y1 `mappend` LookupHidden x2 y2
- = LookupHidden (x1 ++ x2) (y1 ++ y2)
- LookupHidden{} `mappend` l = l
- l `mappend` LookupHidden{} = l
-
- LookupFound m1 `mappend` LookupFound m2
- = ASSERT(fst m1 /= fst m2) LookupMultiple [m1, m2]
- LookupFound m `mappend` LookupMultiple ms
- = ASSERT(not (any ((==fst m).fst) ms)) LookupMultiple (m:ms)
- LookupFound m `mappend` LookupFoundSigs ms check
- | fst m == check = LookupFound m
- | otherwise = LookupMultiple (m:ms)
- l1 `mappend` l2@LookupFound{}
- = l2 `mappend` l1
-
- LookupMultiple ms1 `mappend` LookupFoundSigs ms2 _
- = LookupMultiple (ms1 ++ ms2)
- LookupMultiple ms1 `mappend` LookupMultiple ms2
- = LookupMultiple (ms1 ++ ms2)
- l1 `mappend` l2@LookupMultiple{}
- = l2 `mappend` l1
-
- LookupFoundSigs ms1 m1 `mappend` LookupFoundSigs ms2 m2
- = ASSERT(m1 /= m2) LookupMultiple (ms1 ++ ms2)
-
data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
| SuggestHidden ModuleName Module ModuleOrigin
@@ -1304,28 +1228,23 @@ lookupModuleWithSuggestions :: DynFlags
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions dflags m mb_pn
- = case Map.lookup m (moduleNameDb pkg_state) of
+ = case Map.lookup m (moduleToPkgConfAll pkg_state) of
Nothing -> LookupNotFound suggestions
- Just xs -> mconcat (LookupNotFound suggestions
- :map classify (Map.toList xs))
+ Just xs ->
+ case foldl' classify ([],[],[]) (Map.toList xs) of
+ ([], [], []) -> LookupNotFound suggestions
+ (_, _, [(m, _)]) -> LookupFound m (mod_pkg m)
+ (_, _, exposed@(_:_)) -> LookupMultiple exposed
+ (hidden_pkg, hidden_mod, []) -> LookupHidden hidden_pkg hidden_mod
where
- classify (m, MD origin0 sigs0) =
+ classify (hidden_pkg, hidden_mod, exposed) (m, origin0) =
let origin = filterOrigin mb_pn (mod_pkg m) origin0
- r = (m, origin)
+ x = (m, origin)
in case origin of
- ModHidden -> LookupHidden [] [r]
- _ | originVisible origin -> LookupFound r
- | otherwise ->
- let sigs = do (back_m, back_origin0) <- Map.toList sigs0
- let back_origin = filterOrigin mb_pn
- (mod_pkg back_m)
- back_origin0
- guard (originVisible back_origin)
- return (back_m, back_origin)
- in case sigs of
- [] | originEmpty origin -> LookupNotFound []
- | otherwise -> LookupHidden [r] []
- _ -> LookupFoundSigs sigs m
+ ModHidden -> (hidden_pkg, x:hidden_mod, exposed)
+ _ | originEmpty origin -> (hidden_pkg, hidden_mod, exposed)
+ | originVisible origin -> (hidden_pkg, hidden_mod, x:exposed)
+ | otherwise -> (x:hidden_pkg, hidden_mod, exposed)
pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags
pkg_state = pkgState dflags
@@ -1360,18 +1279,17 @@ lookupModuleWithSuggestions dflags m mb_pn
all_mods :: [(String, ModuleSuggestion)] -- All modules
all_mods = sortBy (comparing fst) $
[ (moduleNameString m, suggestion)
- | (m, e) <- Map.toList (moduleNameDb (pkgState dflags))
+ | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags))
, suggestion <- map (getSuggestion m) (Map.toList e)
]
- -- For now, don't suggest implemented signatures
- getSuggestion name (mod, MD origin _) =
+ getSuggestion name (mod, origin) =
(if originVisible origin then SuggestVisible else SuggestHidden)
name mod origin
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames dflags =
- map fst (filter visible (Map.toList (moduleNameDb (pkgState dflags))))
- where visible (_, ms) = any (\(MD o _) -> originVisible o) (Map.elems ms)
+ map fst (filter visible (Map.toList (moduleToPkgConfAll (pkgState dflags))))
+ where visible (_, ms) = any originVisible (Map.elems ms)
-- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
-- 'PackageConfig's
@@ -1510,7 +1428,7 @@ pprPackagesSimple = pprPackagesWith pprIPI
-- | Show the mapping of modules to where they come from.
pprModuleMap :: DynFlags -> SDoc
pprModuleMap dflags =
- vcat (map pprLine (Map.toList (moduleNameDb (pkgState dflags))))
+ vcat (map pprLine (Map.toList (moduleToPkgConfAll (pkgState dflags))))
where
pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))
pprEntry m (m',o)
diff --git a/docs/users_guide/separate_compilation.xml b/docs/users_guide/separate_compilation.xml
index 281cf146a1..121458f4e6 100644
--- a/docs/users_guide/separate_compilation.xml
+++ b/docs/users_guide/separate_compilation.xml
@@ -970,11 +970,6 @@ ghc -c A.hs
written in a subset of Haskell essentially identical to that of
<literal>hs-boot</literal> files.</para>
- <para>Signatures can be installed like ordinary module files,
- and when multiple signatures are brought into scope under the same
- module name, they are merged together if their backing implementations
- are the same.</para>
-
<para>There is one important gotcha with the current implementation:
currently, instances from backing implementations will "leak" code that
uses signatures, and explicit instance declarations in signatures are
diff --git a/ghc/Main.hs b/ghc/Main.hs
index a1a4eccb12..e2c7479008 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -847,12 +847,11 @@ abiHash strs = do
let modname = mkModuleName str
r <- findImportedModule hsc_env modname Nothing
case r of
- FoundModule h -> return [fr_mod h]
- FoundSigs hs _ -> return (map fr_mod hs)
+ Found _ m -> return m
_error -> throwGhcException $ CmdLineError $ showSDoc dflags $
cannotFindInterface dflags modname r
- mods <- fmap concat (mapM find_it strs)
+ mods <- mapM find_it strs
let get_iface modl = loadUserInterface False (text "abiHash") modl
ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 8a0796dbc4..14704f7f58 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -118,12 +118,6 @@ mk/ghcconfig*_bin_ghc*.exe.mk
/tests/cabal/sigcabal01/p_lazy
/tests/cabal/sigcabal01/p_strict
/tests/cabal/sigcabal01/containers
-/tests/cabal/sigcabal02/Main
-/tests/cabal/sigcabal02/p_ipid
-/tests/cabal/sigcabal02/q_ipid
-/tests/cabal/sigcabal02/containers
-/tests/cabal/sigcabal02/tmp*
-/tests/cabal/sigcabal02/inst*
/tests/cabal/local01.package.conf/
/tests/cabal/local03.package.conf/
/tests/cabal/local04.package.conf/
diff --git a/testsuite/tests/cabal/sigcabal02/Main.hs b/testsuite/tests/cabal/sigcabal02/Main.hs
deleted file mode 100644
index 52def3d41f..0000000000
--- a/testsuite/tests/cabal/sigcabal02/Main.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import Map
-import P
-import Q
-
-main = do
- x <- foo
- print (mymember 5 x)
diff --git a/testsuite/tests/cabal/sigcabal02/Makefile b/testsuite/tests/cabal/sigcabal02/Makefile
deleted file mode 100644
index c45697d1b6..0000000000
--- a/testsuite/tests/cabal/sigcabal02/Makefile
+++ /dev/null
@@ -1,34 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-SETUP=../Setup -v0
-
-# This test is for two Cabal packages exposing the same signature
-
-sigcabal02:
- $(MAKE) clean
- '$(GHC_PKG)' field containers id | sed 's/^.*: *//' > containers
- '$(GHC_PKG)' init tmp.d
- '$(TEST_HC)' -v0 --make Setup
- cd p && $(SETUP) clean
- cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --instantiate-with="Set=Data.Set@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance"
- cd p && $(SETUP) build
- cd p && $(SETUP) copy
- cd p && $(SETUP) register --print-ipid > ../p_ipid
- cd q && $(SETUP) clean
- cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-p' --instantiate-with="Map=Data.Map.Lazy@`cat ../containers`" --ghc-pkg-options="--enable-multi-instance"
- 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 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 containers -package-id "`cat p_ipid`" -package-id "`cat q_ipid`" --make ShouldFail.hs
-ifneq "$(CLEANUP)" ""
- $(MAKE) clean
-endif
-
-clean :
- '$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
- '$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
- $(RM) -r tmp.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/sigcabal02/Setup.hs b/testsuite/tests/cabal/sigcabal02/Setup.hs
deleted file mode 100644
index 9a994af677..0000000000
--- a/testsuite/tests/cabal/sigcabal02/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/testsuite/tests/cabal/sigcabal02/ShouldFail.hs b/testsuite/tests/cabal/sigcabal02/ShouldFail.hs
deleted file mode 100644
index 98ec49e886..0000000000
--- a/testsuite/tests/cabal/sigcabal02/ShouldFail.hs
+++ /dev/null
@@ -1 +0,0 @@
-import Set
diff --git a/testsuite/tests/cabal/sigcabal02/all.T b/testsuite/tests/cabal/sigcabal02/all.T
deleted file mode 100644
index 11eb05975b..0000000000
--- a/testsuite/tests/cabal/sigcabal02/all.T
+++ /dev/null
@@ -1,9 +0,0 @@
-if default_testopts.cleanup != '':
- cleanup = 'CLEANUP=1'
-else:
- cleanup = ''
-
-test('sigcabal02',
- normal,
- run_command,
- ['$MAKE -s --no-print-directory sigcabal02 ' + cleanup])
diff --git a/testsuite/tests/cabal/sigcabal02/p/LICENSE b/testsuite/tests/cabal/sigcabal02/p/LICENSE
deleted file mode 100644
index e69de29bb2..0000000000
--- a/testsuite/tests/cabal/sigcabal02/p/LICENSE
+++ /dev/null
diff --git a/testsuite/tests/cabal/sigcabal02/p/Map.hsig b/testsuite/tests/cabal/sigcabal02/p/Map.hsig
deleted file mode 100644
index 359cf64ab9..0000000000
--- a/testsuite/tests/cabal/sigcabal02/p/Map.hsig
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Map where
-
-import Set
-
-type role Map nominal representational
-data Map k a
-
-instance (Show k, Show a) => Show (Map k a)
-
-size :: Map k a -> Int
-lookup :: Ord k => k -> Map k a -> Maybe a
-empty :: Map k a
-insert :: Ord k => k -> a -> Map k a -> Map k a
-delete :: Ord k => k -> Map k a -> Map k a
-
-keysSet :: Map k a -> Set k
-fromSet :: (k -> a) -> Set k -> Map k a
diff --git a/testsuite/tests/cabal/sigcabal02/p/P.hs b/testsuite/tests/cabal/sigcabal02/p/P.hs
deleted file mode 100644
index dec6b41c94..0000000000
--- a/testsuite/tests/cabal/sigcabal02/p/P.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module P where
-
-import qualified Map
-import qualified Set
-
-foo = do
- let x = Map.insert 0 "foo"
- . Map.insert (6 :: Int) "foo"
- $ Map.empty
- print (Map.lookup 1 x)
- print (Set.size (Map.keysSet x))
- return x
diff --git a/testsuite/tests/cabal/sigcabal02/p/Set.hsig b/testsuite/tests/cabal/sigcabal02/p/Set.hsig
deleted file mode 100644
index 1713133365..0000000000
--- a/testsuite/tests/cabal/sigcabal02/p/Set.hsig
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Set where
-
-type role Set nominal
-data Set a
-
-instance Show a => Show (Set a)
-
-size :: Set a -> Int
-member :: Ord a => a -> Set a -> Bool
-empty :: Set a
-insert :: Ord a => a -> Set a -> Set a
-delete :: Ord a => a -> Set a -> Set a
diff --git a/testsuite/tests/cabal/sigcabal02/p/p.cabal b/testsuite/tests/cabal/sigcabal02/p/p.cabal
deleted file mode 100644
index bb3b2a4463..0000000000
--- a/testsuite/tests/cabal/sigcabal02/p/p.cabal
+++ /dev/null
@@ -1,14 +0,0 @@
-name: p
-version: 1.0
-license-file: LICENSE
-author: Edward Z. Yang
-maintainer: ezyang@cs.stanford.edu
-build-type: Simple
-cabal-version: >=1.20
-
-library
- exposed-modules: P
- exposed-signatures: Map
- required-signatures: Set
- build-depends: base
- default-language: Haskell2010
diff --git a/testsuite/tests/cabal/sigcabal02/q/LICENSE b/testsuite/tests/cabal/sigcabal02/q/LICENSE
deleted file mode 100644
index e69de29bb2..0000000000
--- a/testsuite/tests/cabal/sigcabal02/q/LICENSE
+++ /dev/null
diff --git a/testsuite/tests/cabal/sigcabal02/q/Map.hsig b/testsuite/tests/cabal/sigcabal02/q/Map.hsig
deleted file mode 100644
index 40fd0bc74c..0000000000
--- a/testsuite/tests/cabal/sigcabal02/q/Map.hsig
+++ /dev/null
@@ -1,7 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Map where
-
-type role Map nominal representational
-data Map k a
-
-member :: Ord k => k -> Map k a -> Bool
diff --git a/testsuite/tests/cabal/sigcabal02/q/Q.hs b/testsuite/tests/cabal/sigcabal02/q/Q.hs
deleted file mode 100644
index ba55fb97b7..0000000000
--- a/testsuite/tests/cabal/sigcabal02/q/Q.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Q where
-
-import qualified Map
-import Map(Map)
-
-mymember :: Int -> Map Int a -> Bool
-mymember k m = Map.member k m || Map.member (k + 1) m
diff --git a/testsuite/tests/cabal/sigcabal02/q/q.cabal b/testsuite/tests/cabal/sigcabal02/q/q.cabal
deleted file mode 100644
index 2f99c4403c..0000000000
--- a/testsuite/tests/cabal/sigcabal02/q/q.cabal
+++ /dev/null
@@ -1,13 +0,0 @@
-name: q
-version: 1.0
-license-file: LICENSE
-author: Edward Z. Yang
-maintainer: ezyang@cs.stanford.edu
-build-type: Simple
-cabal-version: >=1.20
-
-library
- exposed-modules: Q
- exposed-signatures: Map
- build-depends: base
- default-language: Haskell2010
diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr b/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr
deleted file mode 100644
index 7c1f09239f..0000000000
--- a/testsuite/tests/cabal/sigcabal02/sigcabal02.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-
-ShouldFail.hs:1:8:
- Could not find module ‘Set’
- Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout b/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout
deleted file mode 100644
index 48cb59e63a..0000000000
--- a/testsuite/tests/cabal/sigcabal02/sigcabal02.stdout
+++ /dev/null
@@ -1,5 +0,0 @@
-[1 of 1] Compiling Main ( Main.hs, Main.o )
-Linking Main ...
-Nothing
-2
-True
diff --git a/testsuite/tests/driver/recomp014/Makefile b/testsuite/tests/driver/recomp014/Makefile
deleted file mode 100644
index e788110097..0000000000
--- a/testsuite/tests/driver/recomp014/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-# -fforce-recomp makes lots of driver tests trivially pass, so we
-# filter it out from $(TEST_HC_OPTS).
-TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS))
-
-# Recompilation tests
-
-clean:
- rm -f *.o *.hi
-
-recomp014: clean
- echo 'module A where a = False' > A.hs
- echo 'module A1 where a = False' > A1.hs
- echo 'module B where a :: Bool' > B.hsig
- echo 'first run'
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A1.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A"
- echo 'import B; main = print a' > C.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
- echo 'second run'
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hsig -sig-of "B is main:A1"
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) A1.o C.o -o recomp014
- ./recomp014
-
-.PHONY: clean recomp014
diff --git a/testsuite/tests/driver/recomp014/all.T b/testsuite/tests/driver/recomp014/all.T
deleted file mode 100644
index affccd2f7f..0000000000
--- a/testsuite/tests/driver/recomp014/all.T
+++ /dev/null
@@ -1,4 +0,0 @@
-test('recomp014',
- [ clean_cmd('$MAKE -s clean') ],
- run_command,
- ['$MAKE -s --no-print-directory recomp014'])
diff --git a/testsuite/tests/driver/recomp014/recomp014.stdout b/testsuite/tests/driver/recomp014/recomp014.stdout
deleted file mode 100644
index 7d540716f0..0000000000
--- a/testsuite/tests/driver/recomp014/recomp014.stdout
+++ /dev/null
@@ -1,4 +0,0 @@
-first run
-compilation IS NOT required
-second run
-False
diff --git a/testsuite/tests/driver/sigof01/Makefile b/testsuite/tests/driver/sigof01/Makefile
index 629d4b656a..84dfc33a9f 100644
--- a/testsuite/tests/driver/sigof01/Makefile
+++ b/testsuite/tests/driver/sigof01/Makefile
@@ -21,9 +21,3 @@ sigof01m:
mkdir tmp_sigof01m
'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof01m --make Main.hs -sig-of "B is main:A" -o tmp_sigof01m/Main
tmp_sigof01m/Main
-
-sigof01i:
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci Main.hs -sig-of "B is main:A" < sigof01i.script
-
-sigof01i2:
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci -sig-of "B is main:A" < sigof01i2.script
diff --git a/testsuite/tests/driver/sigof01/all.T b/testsuite/tests/driver/sigof01/all.T
index 50418b9af0..d0cdc3c02c 100644
--- a/testsuite/tests/driver/sigof01/all.T
+++ b/testsuite/tests/driver/sigof01/all.T
@@ -7,13 +7,3 @@ test('sigof01m',
[ clean_cmd('rm -rf tmp_sigof01m') ],
run_command,
['$MAKE -s --no-print-directory sigof01m'])
-
-test('sigof01i',
- normal,
- run_command,
- ['$MAKE -s --no-print-directory sigof01i'])
-
-test('sigof01i2',
- normal,
- run_command,
- ['$MAKE -s --no-print-directory sigof01i2'])
diff --git a/testsuite/tests/driver/sigof01/sigof01i.script b/testsuite/tests/driver/sigof01/sigof01i.script
deleted file mode 100644
index ba2906d066..0000000000
--- a/testsuite/tests/driver/sigof01/sigof01i.script
+++ /dev/null
@@ -1 +0,0 @@
-main
diff --git a/testsuite/tests/driver/sigof01/sigof01i.stdout b/testsuite/tests/driver/sigof01/sigof01i.stdout
deleted file mode 100644
index bb614cd2a0..0000000000
--- a/testsuite/tests/driver/sigof01/sigof01i.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-False
-T
-True
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.script b/testsuite/tests/driver/sigof01/sigof01i2.script
deleted file mode 100644
index 3a91e377a3..0000000000
--- a/testsuite/tests/driver/sigof01/sigof01i2.script
+++ /dev/null
@@ -1,3 +0,0 @@
-:load B
-:browse B
-:issafe
diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout
deleted file mode 100644
index 1ee81c10d2..0000000000
--- a/testsuite/tests/driver/sigof01/sigof01i2.stdout
+++ /dev/null
@@ -1,9 +0,0 @@
-class Foo a where
- foo :: a -> a
- {-# MINIMAL foo #-}
-data T = A.T
-mkT :: T
-x :: Bool
-Trust type is (Module: Safe, Package: trusted)
-Package Trust: Off
-B is trusted!
diff --git a/testsuite/tests/package/package09e.stderr b/testsuite/tests/package/package09e.stderr
index 70c6f22d89..9cd00a2930 100644
--- a/testsuite/tests/package/package09e.stderr
+++ b/testsuite/tests/package/package09e.stderr
@@ -1,5 +1,5 @@
package09e.hs:2:1:
Ambiguous interface for ‘M’:
- it is bound as Data.Map by a package flag
it is bound as Data.Set by a package flag
+ it is bound as Data.Map by a package flag