X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=f3c859762ac7a6ca785c5e8e2e592f7b50179fe6;hb=2d532e45924dfdb5b5157caf4d3fc3541497d86c;hp=74ecc06637a3bfa34ade484b76289930cf358163;hpb=06575d67c6e85ee746d96c77dab9e40edfb4f7ee;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 74ecc06..f3c8597 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -5,14 +5,17 @@ \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)) - mkHomeModLocation, -- :: ModuleName -> String -> FilePath - -- -> IO ModLocation + findPackageModule, -- :: ModuleName + -- -> IO (Either [FilePath] (Module, ModLocation)) + + mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation + + findLinkable, -- :: ModuleName -> ModLocation -> IO (Maybe Linkable) hiBootExt, -- :: String hiBootVerExt, -- :: String @@ -23,9 +26,9 @@ module Finder ( import Module import UniqFM ( filterUFM ) -import Packages ( PackageConfig(..) ) +import HscTypes ( Linkable(..), Unlinked(..) ) import DriverState -import DriverUtil ( split_longest_prefix ) +import DriverUtil import FastString import Config import Util @@ -49,9 +52,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 @@ -87,28 +87,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 @@ -116,8 +120,8 @@ maybeHomeModule mod_name = do let source_exts = - [ ("hs", mkHomeModLocation mod_name False) - , ("lhs", mkHomeModLocation mod_name False) + [ ("hs", mkHomeModLocationSearched mod_name) + , ("lhs", mkHomeModLocationSearched mod_name) ] hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ] @@ -126,7 +130,7 @@ maybeHomeModule mod_name = do [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name) , (hiBootExt, mkHiOnlyModLocation hisuf mod_name) ] - + -- In compilation manager modes, we look for source files in the home -- package because we can compile these automatically. In one-shot -- compilation mode we look for .hi and .hi-boot files only. @@ -143,7 +147,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 @@ -186,127 +190,167 @@ 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 + basename = dots_to_slashes (moduleNameUserString mod_name) + + 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 +mkHiOnlyModLocation hisuf mod_name path basename _ext = do + -- basename == dots_to_slashes (moduleNameUserString mod_name) + 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 +mkPackageModLocation hisuf mod_name path basename _ext = do + -- basename == dots_to_slashes (moduleNameUserString mod_name) + 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 --- 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). - --- The source filename is specified in three components. For example, --- if we have a module "A.B.C" which was found along the patch "/P/Q/R" --- with extension ".hs", then the full filename is "/P/Q/R/A/B/C.hs". The --- components passed to mkHomeModLocation are +-- This is where we construct the ModLocation for a module in the home +-- package, for which we have a source file. It is called from three +-- places: -- --- path: "/P/Q/R" --- basename: "A/B/C" --- extension: "hs" +-- (a) Here in the finder, when we are searching for a module to import, +-- using the search path (-i option). -- --- the object file and interface file are constructed by possibly --- replacing the path component with the values of the -odir or the --- -hidr options respectively, and the extension with the values of --- the -osuf and -hisuf options respectively. That is, the basename --- always remains intact. +-- (b) The compilation manager, when constructing the ModLocation for +-- a "root" module (a source file named explicitly on the command line +-- or in a :load command in GHCi). -- --- mkHomeModLocation is called directly by the compilation manager to --- construct the information for a root module. For a "root" module, --- the rules are slightly different. The filename is allowed to --- diverge from the module name, but we have to name the interface --- file after the module name. For example, a root module --- "/P/Q/R/foo.hs" will have components +-- (c) The driver in one-shot mode, when we need to construct a +-- ModLocation for a source file named on the command-line. -- --- path: "/P/Q/R" --- basename: "foo" --- extension: "hs" --- --- and we set the flag is_root to True, to indicate that the basename --- portion for the .hi file should be replaced by the last component --- of the module name. eg. if the module name is "A.B.C" then basename --- will be replaced by "C" for the .hi file only, resulting in an --- .hi file like "/P/Q/R/C.hi" (subject to -hidir and -hisuf as usual). - -mkHomeModLocation mod_name is_root path basename extension = do - +-- Parameters are: +-- +-- mod_name +-- The name of the module +-- +-- path +-- (a): The search path component where the source file was found. +-- (b) and (c): "." +-- +-- src_basename +-- (a): dots_to_slashes (moduleNameUserString mod_name) +-- (b) and (c): The filename of the source file, minus its extension +-- +-- ext +-- The filename extension of the source file (usually "hs" or "lhs"). + +mkHomeModLocation mod_name src_filename = do + let mod_basename = dots_to_slashes (moduleNameUserString mod_name) + (basename,extension) = splitFilename src_filename + + case my_prefix_match (reverse mod_basename) (reverse basename) of + Just "" -> + mkHomeModLocationSearched mod_name "." mod_basename extension + Just rest -> do + let path = reverse (dropWhile (=='/') rest) + mkHomeModLocationSearched mod_name path mod_basename extension + Nothing -> do + hPutStrLn stderr ("Warning: " ++ src_filename ++ + ": filename and module name do not match") + let (dir,basename,ext) = splitFilename3 src_filename + mkHomeModLocationSearched mod_name dir basename ext + +mkHomeModLocationSearched mod_name path src_basename ext = do hisuf <- readIORef v_Hi_suf hidir <- readIORef v_Hi_dir - odir <- readIORef v_Output_dir - osuf <- readIORef v_Object_suf - let -- hi filename - mod_str = moduleNameUserString mod_name - (_,mod_suf) = split_longest_prefix mod_str (=='.') + let mod_basename = dots_to_slashes (moduleNameUserString mod_name) - hi_basename - | is_root = mod_suf - | otherwise = basename + obj_fn <- mkObjPath path mod_basename + let -- hi filename, always follows the module name hi_path | Just d <- hidir = d | otherwise = path - hi_fn = hi_path ++ '/':hi_basename ++ '.':hisuf - -- source filename (extension is always .hs or .lhs) - source_fn - | path == "." = basename ++ '.':extension - | otherwise = path ++ '/':basename ++ '.':extension + hi_fn = hi_path ++ '/':mod_basename ++ '.':hisuf - -- the object filename - obj_path | Just d <- odir = d - | otherwise = path - obj_fn = obj_path ++ '/':basename ++ '.':osuf + -- source filename + source_fn = path ++ '/':src_basename ++ '.':ext - 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 :: FilePath -> String -> IO FilePath +-- Construct the filename of a .o 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's no other obvious place for it + +findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable) +findLinkable mod locn + = do let obj_fn = ml_obj_file locn + obj_exist <- doesFileExist obj_fn + if not obj_exist + then return Nothing + else + do let stub_fn = case splitFilename3 obj_fn of + (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o" + stub_exist <- doesFileExist stub_fn + obj_time <- getModificationTime obj_fn + 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])) + +-- ----------------------------------------------------------------------------- +-- Utils + +dots_to_slashes = map (\c -> if c == '.' then '/' else c) + \end{code}