X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=ed3cdf8ddd444815863e80324e7bd6e512dd121e;hb=348b357a272d5faefb9708380beea9187f18a6b3;hp=387864fbe6a6ee4840babe35837b1f9c2d33d955;hpb=2b509caed6d5971af823c71174d2725a123d9753;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 387864f..ed3cdf8 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -7,6 +7,8 @@ module Finder ( initFinder, -- :: PackageConfigInfo -> IO (), findModule, -- :: ModuleName -> IO (Maybe (Module, ModuleLocation)) + mkHomeModuleLocn, -- :: ModuleName -> String -> FilePath + -- -> IO ModuleLocation emptyHomeDirCache -- :: IO () ) where @@ -16,6 +18,7 @@ import HscTypes ( ModuleLocation(..) ) import CmStaticInfo import DriverPhases import DriverState +import DriverUtil import Module import FiniteMap import Util @@ -87,36 +90,46 @@ maybeHomeModule mod_name = do Just home_map -> return home_map - let basename = moduleNameUserString mod_name + let basename = moduleNameUserString mod_name hs = basename ++ ".hs" lhs = basename ++ ".lhs" case lookupFM home_map hs of { - Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs; + Just path -> mkHomeModuleLocn mod_name + (path ++ '/':basename) (path ++ '/':hs); Nothing -> case lookupFM home_map lhs of { - Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) lhs; + Just path -> mkHomeModuleLocn mod_name + (path ++ '/':basename) (path ++ '/':lhs); Nothing -> do -- can't find a source file anywhere, check for a lone .hi file. hisuf <- readIORef v_Hi_suf let hi = basename ++ '.':hisuf case lookupFM home_map hi of { - Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs; + Just path -> mkHomeModuleLocn mod_name + (path ++ '/':basename) (path ++ '/':hs); Nothing -> do - -- last chance: .hi-boot and .hi-boot- + -- last chance: .hi-boot- and .hi-boot let hi_boot = basename ++ ".hi-boot" let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion - case lookupFM home_map hi_boot of { - Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs; - Nothing -> do case lookupFM home_map hi_boot_ver of { - Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs; + Just path -> mkHomeModuleLocn mod_name + (path ++ '/':basename) (path ++ '/':hs); + Nothing -> do + case lookupFM home_map hi_boot of { + Just path -> mkHomeModuleLocn mod_name + (path ++ '/':basename) (path ++ '/':hs); Nothing -> return Nothing }}}}} + +-- The .hi file always follows the module name, whereas the object +-- file may follow the name of the source file in the case where the +-- two differ (see summariseFile in compMan/CompManager.lhs). + mkHomeModuleLocn mod_name basename source_fn = do -- figure out the .hi file name: it lives in the same dir as the @@ -124,7 +137,9 @@ mkHomeModuleLocn mod_name basename source_fn = do ohi <- readIORef v_Output_hi hisuf <- readIORef v_Hi_suf let hifile = case ohi of - Nothing -> basename ++ '.':hisuf + Nothing -> getdir basename + ++ '/':moduleNameUserString mod_name + ++ '.':hisuf Just fn -> fn -- figure out the .o file name. It also lives in the same dir @@ -148,8 +163,7 @@ newPkgCache pkgs = do 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 @@ -168,7 +182,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