X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=4e4844d46005fa41ddf1c526d0498bceb78be1b9;hb=50027272414438955dbc41696541cbd25da55883;hp=43e29d95258ed305463f3a5890e13d17ab04fe7e;hpb=acef71564746becef2c85c310ed57dc8fdd54581;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 43e29d9..4e4844d 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -5,7 +5,7 @@ \begin{code} module Finder ( - initFinder, -- :: PackageConfigInfo -> IO (), + initFinder, -- :: [PackageConfig] -> IO (), findModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation)) mkHomeModuleLocn, -- :: ModuleName -> String -> FilePath -- -> IO ModuleLocation @@ -30,7 +30,7 @@ import Directory import List import IO import Monad -import Outputable ( showSDoc, ppr ) -- debugging only +import Outputable \end{code} The Finder provides a thin filesystem abstraction to the rest of the @@ -49,7 +49,7 @@ GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!", GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath)) -initFinder :: PackageConfigInfo -> IO () +initFinder :: [PackageConfig] -> IO () initFinder pkgs = do { -- expunge our home cache ; writeIORef v_HomeDirCache Nothing @@ -95,11 +95,15 @@ maybeHomeModule mod_name = do lhs = basename ++ ".lhs" case lookupFM home_map hs of { + -- special case to avoid getting "./foo.hs" all the time + Just "." -> mkHomeModuleLocn mod_name basename hs; Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) (path ++ '/':hs); Nothing -> case lookupFM home_map lhs of { + -- special case to avoid getting "./foo.hs" all the time + Just "." -> mkHomeModuleLocn mod_name basename lhs; Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) (path ++ '/':lhs); Nothing -> do @@ -156,15 +160,14 @@ mkHomeModuleLocn mod_name basename source_fn = do )) -newPkgCache :: [Package] -> IO (FiniteMap String (PackageName, FilePath)) +newPkgCache :: [PackageConfig] -> IO (FiniteMap String (PackageName, FilePath)) newPkgCache pkgs = do let extendFM fm pkg = do let dirs = import_dirs pkg pkg_name = _PK_ (name pkg) let addDir fm dir = do contents <- getDirectoryContents' dir - let clean_contents = filter isUsefulFile contents - return (addListToFM fm (zip clean_contents + return (addListToFM fm (zip contents (repeat (pkg_name,dir)))) foldM addDir fm dirs @@ -183,7 +186,7 @@ maybePackageModule mod_name = do then return "hi" else return (tag ++ "_hi") - let basename = moduleNameString mod_name + let basename = moduleNameUserString mod_name hi = basename ++ '.':package_hisuf case lookupFM pkg_cache hi of @@ -208,5 +211,5 @@ getDirectoryContents' d ("WARNING: error while reading directory " ++ d) return [] ) - + \end{code}