X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FFinder.lhs;h=206d118d6e92aabf31f98cc32abe09e1d5d6ad0b;hb=d39d36f836daa3fecd747ebabde09ac895a9553e;hp=25bf90ce130f30757ab2ac671220b0a4731f5f27;hpb=8af9e46751058eecc15d0251c5e250ebcb8367da;p=ghc-hetmet.git diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 25bf90c..206d118 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -4,13 +4,6 @@ \section[Finder]{Module Finder} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Finder ( flushFinderCaches, FindResult(..), @@ -19,6 +12,7 @@ module Finder ( findHomeModule, mkHomeModLocation, mkHomeModLocation2, + mkHiOnlyModLocation, addHomeModuleToFinder, uncacheModule, mkStubPaths, @@ -28,6 +22,7 @@ module Finder ( cannotFindModule, cannotFindInterface, + ) where #include "HsVersions.h" @@ -87,16 +82,25 @@ flushModLocationCache this_pkg ref = do where is_ext mod _ | modulePackageId mod /= this_pkg = True | otherwise = False +addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO () addToFinderCache ref key val = modifyIORef ref $ \c -> addToUFM c key val + +addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO () addToModLocationCache ref key val = modifyIORef ref $ \c -> addToFM c key val +removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO () removeFromFinderCache ref key = modifyIORef ref $ \c -> delFromUFM c key + +removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO () removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key +lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult) lookupFinderCache ref key = do c <- readIORef ref return $! lookupUFM c key +lookupModLocationCache :: IORef ModLocationCache -> Module + -> IO (Maybe ModLocation) lookupModLocationCache ref key = do c <- readIORef ref return $! lookupFM c key @@ -148,6 +152,7 @@ findExactModule hsc_env mod = -- ----------------------------------------------------------------------------- -- Helpers +orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult this `orIfNotFound` or_this = do res <- this case res of @@ -273,6 +278,7 @@ findPackageModule hsc_env mod = do Nothing -> return (NoPackage pkg_id) Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf +findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult findPackageModule_ hsc_env mod pkg_conf = modLocationCache hsc_env mod $ @@ -333,7 +339,7 @@ searchPathExts paths mod exts return result where - basename = dots_to_slashes (moduleNameString (moduleName mod)) + basename = moduleNameSlashes (moduleName mod) to_search :: [(FilePath, IO ModLocation)] to_search = [ (file, fn path basename) @@ -383,7 +389,7 @@ mkHomeModLocationSearched dflags mod suff path basename = do -- (b) and (c): "." -- -- src_basename --- (a): dots_to_slashes (moduleNameUserString mod) +-- (a): (moduleNameSlashes mod) -- (b) and (c): The filename of the source file, minus its extension -- -- ext @@ -400,7 +406,7 @@ mkHomeModLocation2 :: DynFlags -> String -- Suffix -> IO ModLocation mkHomeModLocation2 dflags mod src_basename ext = do - let mod_basename = dots_to_slashes (moduleNameString mod) + let mod_basename = moduleNameSlashes mod obj_fn <- mkObjPath dflags src_basename mod_basename hi_fn <- mkHiPath dflags src_basename mod_basename @@ -474,7 +480,7 @@ mkStubPaths dflags mod location = let stubdir = stubDir dflags - mod_basename = dots_to_slashes (moduleNameString mod) + mod_basename = moduleNameSlashes mod src_basename = basenameOf (expectJust "mkStubPaths" (ml_hs_file location)) @@ -495,7 +501,7 @@ mkStubPaths dflags mod location -- -I