X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=dc7e190f41b5114bc462fc73ec34aa3f101c953f;hb=957bf3756ffd56f5329a2aabe1022d6f996dd641;hp=348eee641021158ba21f58451dcb56c9deb52a5d;hpb=eedc3d35d08d8542e6e3f5f78138b480281e67b2;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 348eee6..dc7e190 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -5,11 +5,13 @@ \begin{code} module Finder ( - initFinder, -- :: [PackageConfig] -> IO (), flushFinderCache, -- :: IO () - findModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) - findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) + findModule, -- :: ModuleName + -- -> IO (Either [FilePath] (Module, ModLocation)) + + findPackageModule, -- :: ModuleName + -- -> IO (Either [FilePath] (Module, ModLocation)) mkHomeModLocation, -- :: ModuleName -> String -> FilePath -- -> IO ModLocation @@ -25,7 +27,6 @@ module Finder ( import Module import UniqFM ( filterUFM ) -import Packages ( PackageConfig(..) ) import HscTypes ( Linkable(..), Unlinked(..) ) import DriverState import DriverUtil ( split_longest_prefix, splitFilename3 ) @@ -52,9 +53,6 @@ import Monad -- It does *not* know which particular package a module lives in, because -- that information is only contained in the interface file. -initFinder :: [PackageConfig] -> IO () -initFinder pkgs = return () - -- ----------------------------------------------------------------------------- -- The finder's cache @@ -90,28 +88,32 @@ lookupFinderCache mod_name = do -- The ModLocation contains the names of all the files associated with -- that module: its source file, .hi file, object file, etc. -findModule :: ModuleName -> IO (Maybe (Module, ModLocation)) +findModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) findModule name = do r <- lookupFinderCache name case r of - Just result -> return (Just result) + Just result -> return (Right result) Nothing -> do j <- maybeHomeModule name case j of - Just home_module -> return (Just home_module) - Nothing -> findPackageMod name - -findPackageModule :: ModuleName -> IO (Maybe (Module, ModLocation)) + Right home_module -> return (Right home_module) + Left home_files -> do + r <- findPackageMod name + case r of + Right pkg_module -> return (Right pkg_module) + Left pkg_files -> return (Left (home_files ++ pkg_files)) + +findPackageModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) findPackageModule name = do r <- lookupFinderCache name case r of - Just result -> return (Just result) + Just result -> return (Right result) Nothing -> findPackageMod name hiBootExt = "hi-boot" hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion -maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModLocation)) +maybeHomeModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) maybeHomeModule mod_name = do home_path <- readIORef v_Import_paths hisuf <- readIORef v_Hi_suf @@ -146,7 +148,7 @@ maybeHomeModule mod_name = do -- ----------------------------------------------------------------------------- -- Looking for a package module -findPackageMod :: ModuleName -> IO (Maybe (Module, ModLocation)) +findPackageMod :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) findPackageMod mod_name = do mode <- readIORef v_GhcMode imp_dirs <- getPackageImportPath -- including the 'auto' ones @@ -189,50 +191,55 @@ searchPathExts String -> String -> String -> IO (Module, ModLocation) -- action ) ] - -> IO (Maybe (Module, ModLocation)) + -> IO (Either [FilePath] (Module, ModLocation)) -searchPathExts path mod_name exts = search path +searchPathExts path mod_name exts = search to_search where mod_str = moduleNameUserString mod_name basename = map (\c -> if c == '.' then '/' else c) mod_str - search [] = return Nothing - search (p:ps) = loop exts - where - base | p == "." = basename - | otherwise = p ++ '/':basename - - loop [] = search ps - loop ((ext,fn):exts) = do - let file = base ++ '.':ext - b <- doesFileExist file - if b then Just `liftM` fn p basename ext - else loop exts + to_search :: [(FilePath, IO (Module,ModLocation))] + to_search = [ (file, fn p basename ext) + | p <- path, + (ext,fn) <- exts, + let base | p == "." = basename + | otherwise = p ++ '/':basename + file = base ++ '.':ext + ] + + search [] = return (Left (map fst to_search)) + search ((file, result) : rest) = do + b <- doesFileExist file + if b + then Right `liftM` result + else search rest -- ----------------------------------------------------------------------------- -- Building ModLocations mkHiOnlyModLocation hisuf mod_name path basename extension = do + loc <- hiOnlyModLocation path basename hisuf + let result = (mkHomeModule mod_name, loc) addToFinderCache mod_name result return result - where - result = ( mkHomeModule mod_name, hiOnlyModLocation path basename hisuf ) mkPackageModLocation hisuf mod_name path basename _extension = do + loc <- hiOnlyModLocation path basename hisuf + let result = (mkPackageModule mod_name, loc) addToFinderCache mod_name result return result - where - result = ( mkPackageModule mod_name, hiOnlyModLocation path basename hisuf ) - -hiOnlyModLocation path basename hisuf = - ModLocation{ ml_hspp_file = Nothing, - ml_hs_file = Nothing, - -- remove the .hi-boot suffix from hi_file, if it - -- had one. We always want the name of the real - -- .hi file in the ml_hi_file field. - ml_hi_file = path ++ '/':basename ++ '.':hisuf, - ml_obj_file = Nothing - } + +hiOnlyModLocation path basename hisuf + = do { obj_fn <- mkObjPath path basename ; + return (ModLocation{ ml_hspp_file = Nothing, + ml_hs_file = Nothing, + ml_hi_file = path ++ '/':basename ++ '.':hisuf, + -- Remove the .hi-boot suffix from + -- hi_file, if it had one. We always + -- want the name of the real .hi file + -- in the ml_hi_file field. + ml_obj_file = obj_fn + })} -- ----------------------------------------------------------------------------- -- Constructing a home module location @@ -277,8 +284,8 @@ mkHomeModLocation mod_name is_root path basename extension = do hisuf <- readIORef v_Hi_suf hidir <- readIORef v_Hi_dir - odir <- readIORef v_Output_dir - osuf <- readIORef v_Object_suf + + obj_fn <- mkObjPath path basename let -- hi filename mod_str = moduleNameUserString mod_name @@ -297,30 +304,38 @@ mkHomeModLocation mod_name is_root path basename extension = do | path == "." = basename ++ '.':extension | otherwise = path ++ '/':basename ++ '.':extension - -- the object filename - obj_path | Just d <- odir = d - | otherwise = path - obj_fn = obj_path ++ '/':basename ++ '.':osuf - - result = ( mkHomeModule mod_name, ModLocation{ ml_hspp_file = Nothing, ml_hs_file = Just source_fn, ml_hi_file = hi_fn, - ml_obj_file = Just obj_fn, + ml_obj_file = obj_fn, }) addToFinderCache mod_name result return result +mkObjPath :: String -> FilePath -> IO FilePath +-- Construct the filename of a .o file from the path/basename +-- derived either from a .hs file or a .hi file. +-- +-- Does *not* check whether the .o file exists +mkObjPath path basename + = do odir <- readIORef v_Output_dir + osuf <- readIORef v_Object_suf + let obj_path | Just d <- odir = d + | otherwise = path + return (obj_path ++ '/':basename ++ '.':osuf) + + + -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, -- but there' no other obvious place for it findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable) findLinkable mod locn - | Just obj_fn <- ml_obj_file locn - = do obj_exist <- doesFileExist obj_fn + = do let obj_fn = ml_obj_file locn + obj_exist <- doesFileExist obj_fn if not obj_exist then return Nothing else @@ -331,6 +346,4 @@ findLinkable mod locn if stub_exist then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn])) else return (Just (LM obj_time mod [DotO obj_fn])) - | otherwise - = return Nothing \end{code}