X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=fbde40f6ea261823652d8bd6b4fdc0a93dd6d6bc;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=0a461d14e58c0c41a7ab4fe4fbb29450f01729b6;hpb=34c2b1b2cdc009b62402bd1c31ffc1ae17df8969;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 0a461d1..fbde40f 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -12,6 +12,8 @@ module Finder ( mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation mkHomeModLocation2, -- :: ModuleName -> FilePath -> String -> IO ModLocation addHomeModuleToFinder, -- :: HscEnv -> Module -> ModLocation -> IO () + uncacheModule, -- :: HscEnv -> Module -> IO () + mkStubPaths, findObjectLinkableMaybe, findObjectLinkable, @@ -22,13 +24,14 @@ module Finder ( #include "HsVersions.h" import Module -import UniqFM ( filterUFM ) +import UniqFM ( filterUFM, delFromUFM ) import HscTypes import Packages import FastString import Util import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) ) import Outputable +import Maybes ( expectJust ) import DATA_IOREF ( IORef, writeIORef, readIORef ) @@ -36,7 +39,6 @@ import Data.List import System.Directory import System.IO import Control.Monad -import Maybes ( MaybeErr(..) ) import Data.Maybe ( isNothing ) import Time ( ClockTime ) @@ -52,7 +54,7 @@ type BaseName = String -- Basename of file -- source, interface, and object files for that module live. -- It does *not* know which particular package a module lives in. Use --- Packages.moduleToPackageConfig for that. +-- Packages.lookupModuleInAllPackages for that. -- ----------------------------------------------------------------------------- -- The finder's cache @@ -69,6 +71,11 @@ addToFinderCache finder_cache mod_name entry = do fm <- readIORef finder_cache writeIORef finder_cache $! extendModuleEnv fm mod_name entry +removeFromFinderCache :: IORef FinderCache -> Module -> IO () +removeFromFinderCache finder_cache mod_name = do + fm <- readIORef finder_cache + writeIORef finder_cache $! delFromUFM fm mod_name + lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FinderCacheEntry) lookupFinderCache finder_cache mod_name = do fm <- readIORef finder_cache @@ -90,8 +97,8 @@ lookupFinderCache finder_cache mod_name = do data FindResult = Found ModLocation PackageIdH -- the module was found - | FoundMultiple ModLocation PackageId - -- *error*: both a home module and a package module + | FoundMultiple [PackageId] + -- *error*: both in multiple packages | PackageHidden PackageId -- for an explicit source import: the package containing the module is -- not exposed. @@ -108,10 +115,10 @@ findPackageModule :: HscEnv -> Module -> Bool -> IO FindResult findPackageModule = findModule' False -type LocalFindResult = MaybeErr [FilePath] FinderCacheEntry - -- LocalFindResult is used for internal functions which - -- return a more informative type; it's munged into - -- the external FindResult by 'cached' +data LocalFindResult + = Ok FinderCacheEntry + | CantFindAmongst [FilePath] + | MultiplePackages [PackageId] findModule' :: Bool -> HscEnv -> Module -> Bool -> IO FindResult findModule' home_allowed hsc_env name explicit @@ -147,52 +154,31 @@ findModule' home_allowed hsc_env name explicit | not home_allowed = do j <- findPackageModule' dflags name case j of - Failed paths -> return (NotFound paths) - Succeeded entry -> found_new entry + Ok entry -> found_new entry + MultiplePackages pkgs -> return (FoundMultiple pkgs) + CantFindAmongst paths -> return (NotFound paths) - | home_allowed && explicit = do - -- for an explict home import, we try looking for - -- both a package module and a home module, and report - -- a FoundMultiple if we find both. + | otherwise = do j <- findHomeModule' dflags name case j of - Failed home_files -> do + Ok entry -> found_new entry + MultiplePackages pkgs -> return (FoundMultiple pkgs) + CantFindAmongst home_files -> do r <- findPackageModule' dflags name case r of - Failed pkg_files -> - return (NotFound (home_files ++ pkg_files)) - Succeeded entry -> - found_new entry - Succeeded entry@(loc,_) -> do - r <- findPackageModule' dflags name - case r of - Failed pkg_files -> found_new entry - Succeeded (_,Just (pkg,_)) -> - return (FoundMultiple loc (packageConfigId pkg)) - Succeeded _ -> - panic "findModule: shouldn't happen" - - -- implicit home imports: check for package modules first, - -- because that's the quickest (doesn't involve filesystem - -- operations). - | home_allowed && not explicit = do - r <- findPackageModule' dflags name - case r of - Failed pkg_files -> do - j <- findHomeModule' dflags name - case j of - Failed home_files -> + CantFindAmongst pkg_files -> return (NotFound (home_files ++ pkg_files)) - Succeeded entry -> + MultiplePackages pkgs -> + return (FoundMultiple pkgs) + Ok entry -> found_new entry - Succeeded entry -> - found_new entry - addHomeModuleToFinder :: HscEnv -> Module -> ModLocation -> IO () addHomeModuleToFinder hsc_env mod loc = addToFinderCache (hsc_FC hsc_env) mod (loc, Nothing) +uncacheModule :: HscEnv -> Module -> IO () +uncacheModule hsc_env mod = removeFromFinderCache (hsc_FC hsc_env) mod -- ----------------------------------------------------------------------------- -- The internal workers @@ -222,9 +208,10 @@ findHomeModule' dflags mod = do findPackageModule' :: DynFlags -> Module -> IO LocalFindResult findPackageModule' dflags mod - = case moduleToPackageConfig dflags mod of - Nothing -> return (Failed []) - Just pkg_info -> findPackageIface dflags mod pkg_info + = case lookupModuleInAllPackages dflags mod of + [] -> return (CantFindAmongst []) + [pkg_info] -> findPackageIface dflags mod pkg_info + many -> return (MultiplePackages (map (mkPackageId.package.fst) many)) findPackageIface :: DynFlags -> Module -> (PackageConfig,Bool) -> IO LocalFindResult findPackageIface dflags mod pkg_info@(pkg_conf, _) = do @@ -280,28 +267,28 @@ searchPathExts paths mod exts return result where - basename = dots_to_slashes (moduleUserString mod) + basename = dots_to_slashes (moduleString mod) to_search :: [(FilePath, IO FinderCacheEntry)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, let base | path == "." = basename - | otherwise = path ++ '/':basename + | otherwise = path `joinFileName` basename file = base `joinFileExt` ext ] - search [] = return (Failed (map fst to_search)) + search [] = return (CantFindAmongst (map fst to_search)) search ((file, mk_result) : rest) = do b <- doesFileExist file if b - then do { res <- mk_result; return (Succeeded res) } + then do { res <- mk_result; return (Ok res) } else search rest mkHomeModLocationSearched :: DynFlags -> Module -> FileExt -> FilePath -> BaseName -> IO FinderCacheEntry mkHomeModLocationSearched dflags mod suff path basename = do - loc <- mkHomeModLocation2 dflags mod (path ++ '/':basename) suff + loc <- mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff return (loc, Nothing) mkHiOnlyModLocation :: DynFlags -> FileExt -> FilePath -> BaseName @@ -360,10 +347,10 @@ mkHomeModLocation2 :: DynFlags -> String -- Suffix -> IO ModLocation mkHomeModLocation2 dflags mod src_basename ext = do - let mod_basename = dots_to_slashes (moduleUserString mod) + let mod_basename = dots_to_slashes (moduleString mod) - obj_fn <- mkObjPath dflags src_basename mod_basename - hi_fn <- mkHiPath dflags src_basename mod_basename + obj_fn <- mkObjPath dflags src_basename mod_basename + hi_fn <- mkHiPath dflags src_basename mod_basename return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext), ml_hi_file = hi_fn, @@ -371,8 +358,8 @@ mkHomeModLocation2 dflags mod src_basename ext = do hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation hiOnlyModLocation dflags path basename hisuf - = do let full_basename = path++'/':basename - obj_fn <- mkObjPath dflags full_basename basename + = do let full_basename = path `joinFileName` basename + obj_fn <- mkObjPath dflags full_basename basename return ModLocation{ ml_hs_file = Nothing, ml_hi_file = full_basename `joinFileExt` hisuf, -- Remove the .hi-boot suffix from @@ -391,10 +378,10 @@ mkObjPath -> IO FilePath mkObjPath dflags basename mod_basename = do let - odir = outputDir dflags + odir = objectDir dflags osuf = objectSuf dflags - obj_basename | Just dir <- odir = dir ++ '/':mod_basename + obj_basename | Just dir <- odir = dir `joinFileName` mod_basename | otherwise = basename return (obj_basename `joinFileExt` osuf) @@ -411,13 +398,43 @@ mkHiPath dflags basename mod_basename hidir = hiDir dflags hisuf = hiSuf dflags - hi_basename | Just dir <- hidir = dir ++ '/':mod_basename + hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename | otherwise = basename return (hi_basename `joinFileExt` hisuf) -- ----------------------------------------------------------------------------- +-- Filenames of the stub files + +-- We don't have to store these in ModLocations, because they can be derived +-- from other available information, and they're only rarely needed. + +mkStubPaths + :: DynFlags + -> Module + -> ModLocation + -> (FilePath,FilePath) + +mkStubPaths dflags mod location + = let + stubdir = stubDir dflags + + mod_basename = dots_to_slashes (moduleString mod) + src_basename = basenameOf (expectJust "mkStubPaths" + (ml_hs_file location)) + + stub_basename0 + | Just dir <- stubdir = dir `joinFileName` mod_basename + | otherwise = src_basename + + stub_basename = stub_basename0 ++ "_stub" + in + (stub_basename `joinFileExt` "c", + stub_basename `joinFileExt` "h") + -- the _stub.o filename is derived from the ml_obj_file. + +-- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, -- but there's no other obvious place for it @@ -450,13 +467,10 @@ dots_to_slashes = map (\c -> if c == '.' then '/' else c) -- Error messages cantFindError :: DynFlags -> Module -> FindResult -> SDoc -cantFindError dflags mod_name (FoundMultiple loc pkg) +cantFindError dflags mod_name (FoundMultiple pkgs) = hang (ptext SLIT("Cannot import") <+> quotes (ppr mod_name) <> colon) 2 ( - sep [ptext SLIT("it was found in both") <+> - (case ml_hs_file loc of Nothing -> ptext SLIT("") - Just f -> text f), - ptext SLIT("and package") <+> ppr pkg <> char '.'] $$ - ptext SLIT("Possible fix: -ignore-package") <+> ppr pkg + sep [ptext SLIT("it was found in multiple packages:"), + hsep (map (text.packageIdString) pkgs)] ) cantFindError dflags mod_name find_result = hang (ptext SLIT("Could not find module") <+> quotes (ppr mod_name) <> colon) @@ -481,5 +495,5 @@ cantFindError dflags mod_name find_result -> hang (ptext SLIT("locations searched:")) 2 (vcat (map text files)) - Found _ _ -> panic "cantFindErr" + _ -> panic "cantFindErr" \end{code}