Commit 214596de authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Revert "Revert "Support for multiple signature files in scope.""

This reverts commit bac927b9.

As it turns out, we need these commits for separate compilation
and accurate dependency tracking.  So back in they go!
parent 0c6c015d
...@@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside ...@@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
else do { else do {
; result <- liftIO $ findImportedModule hsc_env modname Nothing ; result <- liftIO $ findImportedModule hsc_env modname Nothing
; case result of ; case result of
Found _ mod -> loadModule err mod FoundModule h -> loadModule err (fr_mod h)
_ -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err _ -> pprPgmError "Unable to use Data Parallel Haskell (DPH):" err
} } } }
......
...@@ -562,23 +562,29 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods ...@@ -562,23 +562,29 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
-- 3. For each dependent module, find its linkable -- 3. For each dependent module, find its linkable
-- This will either be in the HPT or (in the case of one-shot -- This will either be in the HPT or (in the case of one-shot
-- compilation) we may need to use maybe_getFileLinkable -- compilation) we may need to use maybe_getFileLinkable.
-- If the module is actually a signature, there won't be a
-- linkable (thus catMaybes)
; let { osuf = objectSuf dflags } ; let { osuf = objectSuf dflags }
; lnks_needed <- mapM (get_linkable osuf) mods_needed ; lnks_needed <- fmap Maybes.catMaybes
$ mapM (get_linkable osuf) mods_needed
; return (lnks_needed, pkgs_needed) } ; return (lnks_needed, pkgs_needed) }
where where
dflags = hsc_dflags hsc_env dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags this_pkg = thisPackage dflags
-- The ModIface contains the transitive closure of the module dependencies -- | Given a list of modules @mods@, recursively discover all external
-- within the current package, *except* for boot modules: if we encounter -- package and local module (according to @this_pkg@) dependencies.
-- a boot module, we have to find its real interface and discover the --
-- dependencies of that. Hence we need to traverse the dependency -- The 'ModIface' contains the transitive closure of the module dependencies
-- tree recursively. See bug #936, testcase ghci/prog007. -- within the current package, *except* for boot modules: if we encounter
follow_deps :: [Module] -- modules to follow -- a boot module, we have to find its real interface and discover the
-> UniqSet ModuleName -- accum. module dependencies -- dependencies of that. Hence we need to traverse the dependency
-> UniqSet PackageKey -- accum. package dependencies -- 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 -> IO ([ModuleName], [PackageKey]) -- result
follow_deps [] acc_mods acc_pkgs follow_deps [] acc_mods acc_pkgs
= return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
...@@ -601,6 +607,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods ...@@ -601,6 +607,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
where is_boot (m,True) = Left m where is_boot (m,True) = Left m
is_boot (m,False) = Right m is_boot (m,False) = Right m
-- Boot module dependencies which must be processed recursively
boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps boot_deps' = filter (not . (`elementOfUniqSet` acc_mods)) boot_deps
acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps) acc_mods' = addListToUniqSet acc_mods (moduleName mod : mod_deps)
acc_pkgs' = addListToUniqSet acc_pkgs $ map fst pkg_deps acc_pkgs' = addListToUniqSet acc_pkgs $ map fst pkg_deps
...@@ -631,30 +638,37 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods ...@@ -631,30 +638,37 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
get_linkable osuf mod_name -- A home-package module get_linkable osuf mod_name -- A home-package module
| Just mod_info <- lookupUFM hpt mod_name | Just mod_info <- lookupUFM hpt mod_name
= adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info)) = adjust_linkable (hm_iface mod_info)
(Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
| otherwise | otherwise
= do -- It's not in the HPT because we are in one shot mode, = do -- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation... -- 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 mb_stuff <- findHomeModule hsc_env mod_name
case mb_stuff of case mb_stuff of
Found loc mod -> found loc mod FoundExact loc mod -> found loc mod
_ -> no_obj mod_name _ -> no_obj mod_name
where where
found loc mod = do { found loc mod = do {
-- ...and then find the linkable for it -- ...and then find the linkable for it
mb_lnk <- findObjectLinkableMaybe mod loc ; mb_lnk <- findObjectLinkableMaybe mod loc ;
iface <- initIfaceCheck hsc_env $
loadUserInterface False (text "getLinkDeps2") mod ;
case mb_lnk of { case mb_lnk of {
Nothing -> no_obj mod ; Nothing -> no_obj mod ;
Just lnk -> adjust_linkable lnk Just lnk -> adjust_linkable iface lnk
}} }}
adjust_linkable lnk adjust_linkable iface lnk
-- Signatures have no linkables! Don't return one.
| Just _ <- mi_sig_of iface = return Nothing
| Just new_osuf <- replace_osuf = do | Just new_osuf <- replace_osuf = do
new_uls <- mapM (adjust_ul new_osuf) new_uls <- mapM (adjust_ul new_osuf)
(linkableUnlinked lnk) (linkableUnlinked lnk)
return lnk{ linkableUnlinked=new_uls } return (Just lnk{ linkableUnlinked=new_uls })
| otherwise = | otherwise =
return lnk return (Just lnk)
adjust_ul new_osuf (DotO file) = do adjust_ul new_osuf (DotO file) = do
MASSERT(osuf `isSuffixOf` file) MASSERT(osuf `isSuffixOf` file)
......
...@@ -297,12 +297,17 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg ...@@ -297,12 +297,17 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be -- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search. -- cached from the first search.
= do { hsc_env <- getTopEnv = do { hsc_env <- getTopEnv
-- ToDo: findImportedModule should return a list of interfaces
; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
; case res of ; case res of
Found _ mod -> fmap (fmap (:[])) FoundModule (FoundHs { fr_mod = mod })
. initIfaceTcRn -> fmap (fmap (:[]))
$ loadInterface doc mod (ImportByUser want_boot) . 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)
err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) } err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
-- | Load interface directly for a fully qualified 'Module'. (This is a fairly -- | Load interface directly for a fully qualified 'Module'. (This is a fairly
...@@ -742,7 +747,7 @@ findAndReadIface doc_str mod hi_boot_file ...@@ -742,7 +747,7 @@ findAndReadIface doc_str mod hi_boot_file
hsc_env <- getTopEnv hsc_env <- getTopEnv
mb_found <- liftIO (findExactModule hsc_env mod) mb_found <- liftIO (findExactModule hsc_env mod)
case mb_found of case mb_found of
Found loc mod -> do FoundExact loc mod -> do
-- Found file, so read it -- Found file, so read it
let file_path = addBootSuffix_maybe hi_boot_file let file_path = addBootSuffix_maybe hi_boot_file
...@@ -759,7 +764,8 @@ findAndReadIface doc_str mod hi_boot_file ...@@ -759,7 +764,8 @@ findAndReadIface doc_str mod hi_boot_file
traceIf (ptext (sLit "...not found")) traceIf (ptext (sLit "...not found"))
dflags <- getDynFlags dflags <- getDynFlags
return (Failed (cannotFindInterface dflags return (Failed (cannotFindInterface dflags
(moduleName mod) err)) (moduleName mod)
(convFindExactResult err)))
where read_file file_path = do where read_file file_path = do
traceIf (ptext (sLit "readIFace") <+> text file_path) traceIf (ptext (sLit "readIFace") <+> text file_path)
read_result <- readIface mod file_path read_result <- readIface mod file_path
......
...@@ -1334,9 +1334,20 @@ checkDependencies hsc_env summary iface ...@@ -1334,9 +1334,20 @@ checkDependencies hsc_env summary iface
find_res <- liftIO $ findImportedModule hsc_env mod (fmap snd pkg) find_res <- liftIO $ findImportedModule hsc_env mod (fmap snd pkg)
let reason = moduleNameString mod ++ " changed" let reason = moduleNameString mod ++ " changed"
case find_res of case find_res of
Found _ mod 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
| pkg == this_pkg | pkg == this_pkg
-> if moduleName mod `notElem` map fst prev_dep_mods = if moduleName mod `notElem` map fst prev_dep_mods
then do traceHiDiffs $ then do traceHiDiffs $
text "imported module " <> quotes (ppr mod) <> text "imported module " <> quotes (ppr mod) <>
text " not among previous dependencies" text " not among previous dependencies"
...@@ -1344,7 +1355,7 @@ checkDependencies hsc_env summary iface ...@@ -1344,7 +1355,7 @@ checkDependencies hsc_env summary iface
else else
return UpToDate return UpToDate
| otherwise | otherwise
-> if pkg `notElem` (map fst prev_dep_pkgs) = if pkg `notElem` (map fst prev_dep_pkgs)
then do traceHiDiffs $ then do traceHiDiffs $
text "imported module " <> quotes (ppr mod) <> text "imported module " <> quotes (ppr mod) <>
text " is from package " <> quotes (ppr pkg) <> text " is from package " <> quotes (ppr pkg) <>
...@@ -1353,7 +1364,6 @@ checkDependencies hsc_env summary iface ...@@ -1353,7 +1364,6 @@ checkDependencies hsc_env summary iface
else else
return UpToDate return UpToDate
where pkg = modulePackageKey mod where pkg = modulePackageKey mod
_otherwise -> return (RecompBecause reason)
needInterface :: Module -> (ModIface -> IfG RecompileRequired) needInterface :: Module -> (ModIface -> IfG RecompileRequired)
-> IfG RecompileRequired -> IfG RecompileRequired
......
...@@ -248,7 +248,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps ...@@ -248,7 +248,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
-- we've done it once during downsweep -- we've done it once during downsweep
r <- findImportedModule hsc_env imp pkg r <- findImportedModule hsc_env imp pkg
; case r of ; case r of
Found loc _ FoundModule (FoundHs { fr_loc = loc })
-- Home package: just depend on the .hi or hi-boot file -- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps | isJust (ml_hs_file loc) || include_pkg_deps
-> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc))) -> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
...@@ -257,6 +257,9 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps ...@@ -257,6 +257,9 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
| otherwise | otherwise
-> return Nothing -> return Nothing
-- TODO: FoundSignature. For now, we assume home package
-- "signature" dependencies look like FoundModule.
fail -> fail ->
let dflags = hsc_dflags hsc_env let dflags = hsc_dflags hsc_env
in throwOneError $ mkPlainErrMsg dflags srcloc $ in throwOneError $ mkPlainErrMsg dflags srcloc $
......
...@@ -203,7 +203,15 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do ...@@ -203,7 +203,15 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- First find the package the module resides in by searching exposed packages and home modules -- First find the package the module resides in by searching exposed packages and home modules
found_module <- findImportedModule hsc_env mod_name Nothing found_module <- findImportedModule hsc_env mod_name Nothing
case found_module of case found_module of
Found _ mod -> do 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
-- Find the exports of the module -- Find the exports of the module
(_, mb_iface) <- initTcInteractive hsc_env $ (_, mb_iface) <- initTcInteractive hsc_env $
initIfaceTcRn $ initIfaceTcRn $
...@@ -221,10 +229,13 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do ...@@ -221,10 +229,13 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
_ -> panic "lookupRdrNameInModule" _ -> panic "lookupRdrNameInModule"
Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name] Nothing -> throwCmdLineErrorS dflags $ hsep [ptext (sLit "Could not determine the exports of the module"), ppr mod_name]
err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
where check_mods [] = return Nothing
dflags = hsc_dflags hsc_env check_mods (m:ms) = do
doc = ptext (sLit "contains a name used in an invocation of lookupRdrNameInModule") r <- check_mod m
case r of
Nothing -> check_mods ms
Just _ -> return r
wrongTyThingError :: Name -> TyThing -> SDoc 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] 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]
......
...@@ -9,6 +9,7 @@ ...@@ -9,6 +9,7 @@
module Finder ( module Finder (
flushFinderCaches, flushFinderCaches,
FindResult(..), FindResult(..),
convFindExactResult, -- move to HscTypes?
findImportedModule, findImportedModule,
findExactModule, findExactModule,
findHomeModule, findHomeModule,
...@@ -45,8 +46,7 @@ import System.Directory ...@@ -45,8 +46,7 @@ import System.Directory
import System.FilePath import System.FilePath
import Control.Monad import Control.Monad
import Data.Time import Data.Time
import Data.List ( foldl' ) import Data.List ( foldl', partition )
type FileExt = String -- Filename extension type FileExt = String -- Filename extension
type BaseName = String -- Basename of file type BaseName = String -- Basename of file
...@@ -75,7 +75,7 @@ flushFinderCaches hsc_env = ...@@ -75,7 +75,7 @@ flushFinderCaches hsc_env =
is_ext mod _ | modulePackageKey mod /= this_pkg = True is_ext mod _ | modulePackageKey mod /= this_pkg = True
| otherwise = False | otherwise = False
addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO () addToFinderCache :: IORef FinderCache -> Module -> FindExactResult -> IO ()
addToFinderCache ref key val = addToFinderCache ref key val =
atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ()) atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ())
...@@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO () ...@@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
removeFromFinderCache ref key = removeFromFinderCache ref key =
atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ()) atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ())
lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindResult) lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindExactResult)
lookupFinderCache ref key = do lookupFinderCache ref key = do
c <- readIORef ref c <- readIORef ref
return $! lookupModuleEnv c key return $! lookupModuleEnv c key
...@@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg = ...@@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg =
Just pkg | pkg == fsLit "this" -> home_import -- "this" is special Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
| otherwise -> pkg_import | otherwise -> pkg_import
where where
home_import = findHomeModule hsc_env mod_name home_import = convFindExactResult `fmap` findHomeModule hsc_env mod_name
pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
...@@ -118,7 +118,7 @@ findImportedModule 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, -- reading the interface for a module mentioned by another interface,
-- for example (a "system import"). -- for example (a "system import").
findExactModule :: HscEnv -> Module -> IO FindResult findExactModule :: HscEnv -> Module -> IO FindExactResult
findExactModule hsc_env mod = findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env let dflags = hsc_dflags hsc_env
in if modulePackageKey mod == thisPackage dflags in if modulePackageKey mod == thisPackage dflags
...@@ -152,17 +152,45 @@ orIfNotFound this or_this = do ...@@ -152,17 +152,45 @@ orIfNotFound this or_this = do
-- been done. Otherwise, do the lookup (with the IO action) and save -- 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 -- the result in the finder cache and the module location cache (if it
-- was successful.) -- was successful.)
homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult homeSearchCache :: HscEnv
-> ModuleName
-> IO FindExactResult
-> IO FindExactResult
homeSearchCache hsc_env mod_name do_this = do homeSearchCache hsc_env mod_name do_this = do
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
modLocationCache hsc_env mod do_this 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 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult -> IO FindResult
findExposedPackageModule hsc_env mod_name mb_pkg findExposedPackageModule hsc_env mod_name mb_pkg
= case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
LookupFound m pkg_conf -> LookupFound (m, _) -> do
findPackageModule_ hsc_env m pkg_conf 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)
LookupMultiple rs -> LookupMultiple rs ->
return (FoundMultiple rs) return (FoundMultiple rs)
LookupHidden pkg_hiddens mod_hiddens -> LookupHidden pkg_hiddens mod_hiddens ->
...@@ -176,7 +204,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg ...@@ -176,7 +204,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg
, fr_mods_hidden = [] , fr_mods_hidden = []
, fr_suggestions = suggest }) , fr_suggestions = suggest })
modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult modLocationCache :: HscEnv -> Module -> IO FindExactResult -> IO FindExactResult
modLocationCache hsc_env mod do_this = do modLocationCache hsc_env mod do_this = do
m <- lookupFinderCache (hsc_FC hsc_env) mod m <- lookupFinderCache (hsc_FC hsc_env) mod
case m of case m of
...@@ -189,7 +217,7 @@ modLocationCache hsc_env mod do_this = do ...@@ -189,7 +217,7 @@ modLocationCache hsc_env mod do_this = do
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do addHomeModuleToFinder hsc_env mod_name loc = do
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
addToFinderCache (hsc_FC hsc_env) mod (Found loc mod) addToFinderCache (hsc_FC hsc_env) mod (FoundExact loc mod)
return mod return mod
uncacheModule :: HscEnv -> ModuleName -> IO () uncacheModule :: HscEnv -> ModuleName -> IO ()
...@@ -216,7 +244,7 @@ uncacheModule hsc_env mod = do ...@@ -216,7 +244,7 @@ uncacheModule hsc_env mod = do
-- --
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.) -- call this.)
findHomeModule :: HscEnv -> ModuleName -> IO FindResult findHomeModule :: HscEnv -> ModuleName -> IO FindExactResult
findHomeModule hsc_env mod_name = findHomeModule hsc_env mod_name =
homeSearchCache hsc_env mod_name $ homeSearchCache hsc_env mod_name $
let let
...@@ -247,19 +275,19 @@ findHomeModule hsc_env mod_name = ...@@ -247,19 +275,19 @@ findHomeModule hsc_env mod_name =
-- This is important only when compiling the base package (where GHC.Prim -- This is important only when compiling the base package (where GHC.Prim
-- is a home module). -- is a home module).
if mod == gHC_PRIM if mod == gHC_PRIM
then return (Found (error "GHC.Prim ModLocation") mod) then return (FoundExact (error "GHC.Prim ModLocation") mod)
else searchPathExts home_path mod exts else searchPathExts home_path mod exts
-- | Search for a module in external packages only. -- | Search for a module in external packages only.
findPackageModule :: HscEnv -> Module -> IO FindResult findPackageModule :: HscEnv -> Module -> IO FindExactResult
findPackageModule hsc_env mod = do findPackageModule hsc_env mod = do
let let
dflags = hsc_dflags hsc_env dflags = hsc_dflags hsc_env
pkg_id = modulePackageKey mod pkg_id = modulePackageKey mod
-- --
case lookupPackage dflags pkg_id of case lookupPackage dflags pkg_id of
Nothing -> return (NoPackage pkg_id) Nothing -> return (NoPackageExact pkg_id)
Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
-- | Look up the interface file associated with module @mod@. This function -- | Look up the interface file associated with module @mod@. This function
...@@ -269,14 +297,14 @@ findPackageModule hsc_env mod = do ...@@ -269,14 +297,14 @@ findPackageModule hsc_env mod = do
-- the 'PackageConfig' must be consistent with the package key in the 'Module'. -- the 'PackageConfig' must be consistent with the package key in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state -- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config. -- for the appropriate config.
findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindExactResult
findPackageModule_ hsc_env mod pkg_conf = findPackageModule_ hsc_env mod pkg_conf =
ASSERT( modulePackageKey mod == packageConfigId pkg_conf ) ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
modLocationCache hsc_env mod $ modLocationCache hsc_env mod $
-- special case for GHC.Prim; we won't find it in the filesystem. -- special case for GHC.Prim; we won't find it in the filesystem.
if mod == gHC_PRIM if mod == gHC_PRIM
then return (Found (error "GHC.Prim ModLocation") mod) then return (FoundExact (error "GHC.Prim ModLocation") mod)
else else
let let
...@@ -299,7 +327,7 @@ findPackageModule_ hsc_env mod pkg_conf = ...@@ -299,7 +327,7 @@ findPackageModule_ hsc_env mod pkg_conf =
-- don't bother looking for it. -- don't bother looking for it.
let basename = moduleNameSlashes (moduleName mod) let basename = moduleNameSlashes (moduleName mod)
loc <- mk_hi_loc one basename loc <- mk_hi_loc one basename
return (Found loc mod) return (FoundExact loc mod)
_otherwise -> _otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)] searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
...@@ -314,7 +342,7 @@ searchPathExts ...@@ -314,7 +342,7 @@ searchPathExts
FilePath -> BaseName -> IO ModLocation -- action FilePath -> BaseName -> IO ModLocation -- action
) )
] ]
-> IO FindResult -> IO FindExactResult
searchPathExts paths mod exts searchPathExts paths mod exts
= do result <- search to_search = do result <- search to_search
...@@ -340,15 +368,13 @@ searchPathExts paths mod exts ...@@ -340,15 +368,13 @@ searchPathExts paths mod exts
file = base <.> ext file = base <.> ext
] ]
search [] = return (NotFound { fr_paths = map fst to_search search [] = return (NotFoundExact {fer_paths = map fst to_search
, fr_pkg = Just (modulePackageKey mod) ,fer_pkg = Just (modulePackageKey mod)})
, fr_mods_hidden = [], fr_pkgs_hidden = []
, fr_suggestions = [] })