X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=c255408fac0b41803eb3bbb3a6d7e666fd7c5392;hb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;hp=a16aab10ca11a4a1798709be16a22ee8b4e0bb59;hpb=392095c950c3e242e88bf56bb401869a2f291abf;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index a16aab1..c255408 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -6,13 +6,10 @@ \begin{code} module Finder ( flushFinderCache, -- :: IO () - - findModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) - findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) - - mkHomeModLocation, -- :: ModuleName -> String -> FilePath - -- -> IO ModLocation - + FindResult(..), + findModule, -- :: ModuleName -> Bool -> IO FindResult + findPackageModule, -- :: ModuleName -> Bool -> IO FindResult + mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation findLinkable, -- :: ModuleName -> ModLocation -> IO (Maybe Linkable) hiBootExt, -- :: String @@ -24,54 +21,56 @@ module Finder ( import Module import UniqFM ( filterUFM ) -import Packages ( PackageConfig(..) ) -import HscTypes ( Linkable(..), Unlinked(..) ) +import HscTypes ( Linkable(..), Unlinked(..), IfacePackage(..) ) +import Packages import DriverState -import DriverUtil ( split_longest_prefix, splitFilename3 ) +import DriverUtil import FastString import Config import Util +import CmdLineOpts ( DynFlags(..) ) import DATA_IOREF ( IORef, writeIORef, readIORef ) -import List -import Directory -import IO -import Monad +import Data.List +import System.Directory +import System.IO +import Control.Monad +import Data.Maybe ( isNothing ) -- ----------------------------------------------------------------------------- -- The Finder --- The Finder provides a thin filesystem abstraction to the rest of the --- compiler. For a given module, it knows (a) whether the module lives --- in the home package or in another package, so it can make a Module --- from a ModuleName, and (b) where the source, interface, and object --- files for a module live. +-- The Finder provides a thin filesystem abstraction to the rest of +-- the compiler. For a given module, it can tell you where the +-- source, interface, and object files for that module live. -- --- It does *not* know which particular package a module lives in, because --- that information is only contained in the interface file. +-- It does *not* know which particular package a module lives in. Use +-- Packages.moduleToPackageConfig for that. -- ----------------------------------------------------------------------------- -- The finder's cache -GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation)) +GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv FinderCacheEntry) + +type FinderCacheEntry = (ModLocation,Maybe (PackageConfig,Bool)) -- remove all the home modules from the cache; package modules are -- assumed to not move around during a session. flushFinderCache :: IO () flushFinderCache = do fm <- readIORef finder_cache - writeIORef finder_cache (filterUFM (not . isHomeModule . fst) fm) + writeIORef finder_cache (filterUFM (\(loc,m) -> isNothing m) fm) -addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO () -addToFinderCache mod_name stuff = do +addToFinderCache :: Module -> FinderCacheEntry -> IO () +addToFinderCache mod_name entry = do fm <- readIORef finder_cache - writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff) + writeIORef finder_cache (extendModuleEnv fm mod_name entry) -lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation)) +lookupFinderCache :: Module -> IO (Maybe FinderCacheEntry) lookupFinderCache mod_name = do fm <- readIORef finder_cache - return $! lookupModuleEnvByName fm mod_name + return $! lookupModuleEnv fm mod_name -- ----------------------------------------------------------------------------- -- Locating modules @@ -86,46 +85,83 @@ 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 name = do - r <- lookupFinderCache name - case r of - Just result -> return (Just 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)) -findPackageModule name = do - r <- lookupFinderCache name - case r of - Just result -> return (Just result) - Nothing -> findPackageMod name +data FindResult + = Found ModLocation IfacePackage + -- the module was found + | PackageHidden PackageId + -- for an explicit source import: the package containing the module is + -- not exposed. + | ModuleHidden PackageId + -- for an explicit source import: the package containing the module is + -- exposed, but the module itself is hidden. + | NotFound [FilePath] + -- the module was not found, the specified places were searched. + +findModule :: DynFlags -> Module -> Bool -> IO FindResult +findModule = cached findModule' + +findModule' :: DynFlags -> Module -> Bool -> IO FindResult +findModule' dflags name explicit = do + j <- maybeHomeModule dflags name + case j of + NotFound home_files -> do + r <- findPackageModule' dflags name explicit + case r of + NotFound pkg_files + -> return (NotFound (home_files ++ pkg_files)) + other_result + -> return other_result + other_result -> return other_result + +cached fn dflags name explicit = do + m <- lookupFinderCache name + case m of + Nothing -> fn dflags name explicit + Just (loc,maybe_pkg) + | Just err <- visible explicit maybe_pkg -> return err + | otherwise -> return (Found loc (pkgInfoToId maybe_pkg)) + +pkgInfoToId :: Maybe (PackageConfig,Bool) -> IfacePackage +pkgInfoToId (Just (pkg,_)) = ExternalPackage (mkPackageId (package pkg)) +pkgInfoToId Nothing = ThisPackage + +-- Is a module visible or not? Returns Nothing if the import is ok, +-- or Just err if there's a visibility error. +visible :: Bool -> Maybe (PackageConfig,Bool) -> Maybe FindResult +visible explicit maybe_pkg + | Nothing <- maybe_pkg = Nothing -- home module ==> YES + | not explicit = Nothing -- implicit import ==> YES + | Just (pkg, exposed_module) <- maybe_pkg + = case () of + _ | not exposed_module -> Just (ModuleHidden pkgname) + | not (exposed pkg) -> Just (PackageHidden pkgname) + | otherwise -> Nothing + where + pkgname = packageConfigId pkg + hiBootExt = "hi-boot" hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion -maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModLocation)) -maybeHomeModule mod_name = do - home_path <- readIORef v_Import_paths +maybeHomeModule :: DynFlags -> Module -> IO FindResult +maybeHomeModule dflags mod = do + let home_path = importPaths dflags hisuf <- readIORef v_Hi_suf mode <- readIORef v_GhcMode let source_exts = - [ ("hs", mkHomeModLocation mod_name False) - , ("lhs", mkHomeModLocation mod_name False) + [ ("hs", mkHomeModLocationSearched mod) + , ("lhs", mkHomeModLocationSearched mod) ] - hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ] + hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod) ] boot_exts = - [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name) - , (hiBootExt, mkHiOnlyModLocation hisuf mod_name) + [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod) + , (hiBootExt, mkHiOnlyModLocation hisuf mod) ] - + -- 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. @@ -137,16 +173,33 @@ maybeHomeModule mod_name = do | isCompManagerMode mode = source_exts | otherwise {-one-shot-} = hi_exts ++ boot_exts - searchPathExts home_path mod_name exts + searchPathExts home_path mod exts -- ----------------------------------------------------------------------------- -- Looking for a package module -findPackageMod :: ModuleName -> IO (Maybe (Module, ModLocation)) -findPackageMod mod_name = do +findPackageModule :: DynFlags -> Module -> Bool -> IO FindResult +findPackageModule = cached findPackageModule' + +findPackageModule' :: DynFlags -> Module -> Bool -> IO FindResult +findPackageModule' dflags mod explicit = do mode <- readIORef v_GhcMode - imp_dirs <- getPackageImportPath -- including the 'auto' ones + case moduleToPackageConfig dflags mod of + Nothing -> return (NotFound []) + pkg_info@(Just (pkg_conf, module_exposed)) + | Just err <- visible explicit pkg_info -> return err + | otherwise -> findPackageIface mode mod paths pkg_info + where + paths = importDirs pkg_conf + +findPackageIface + :: GhcMode + -> Module + -> [FilePath] + -> Maybe (PackageConfig,Bool) + -> IO FindResult +findPackageIface mode mod imp_dirs pkg_info = do -- hi-suffix for packages depends on the build tag. package_hisuf <- do tag <- readIORef v_Build_tag @@ -156,13 +209,14 @@ findPackageMod mod_name = do let hi_exts = - [ (package_hisuf, mkPackageModLocation package_hisuf mod_name) ] + [ (package_hisuf, + mkPackageModLocation pkg_info package_hisuf mod) ] source_exts = - [ ("hs", mkPackageModLocation package_hisuf mod_name) - , ("lhs", mkPackageModLocation package_hisuf mod_name) + [ ("hs", mkPackageModLocation pkg_info package_hisuf mod) + , ("lhs", mkPackageModLocation pkg_info package_hisuf mod) ] - + -- mkdependHS needs to look for source files in packages too, so -- that we can make dependencies between package before they have -- been built. @@ -172,157 +226,159 @@ findPackageMod mod_name = do -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. - searchPathExts imp_dirs mod_name exts + searchPathExts imp_dirs mod exts -- ----------------------------------------------------------------------------- -- General path searching searchPathExts :: [FilePath] -- paths to search - -> ModuleName -- module name + -> Module -- module name -> [ ( - String, -- suffix - String -> String -> String -> IO (Module, ModLocation) -- action + String, -- suffix + String -> String -> String -> IO FindResult -- action ) ] - -> IO (Maybe (Module, ModLocation)) + -> IO FindResult -searchPathExts path mod_name exts = search path +searchPathExts path mod 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 (moduleUserString mod) + + to_search :: [(FilePath, IO FindResult)] + to_search = [ (file, fn p basename ext) + | p <- path, + (ext,fn) <- exts, + let base | p == "." = basename + | otherwise = p ++ '/':basename + file = base ++ '.':ext + ] + + search [] = return (NotFound (map fst to_search)) + search ((file, result) : rest) = do + b <- doesFileExist file + if b + then result + else search rest -- ----------------------------------------------------------------------------- -- Building ModLocations -mkHiOnlyModLocation hisuf mod_name path basename extension = do +mkHiOnlyModLocation hisuf mod path basename _ext = do + -- basename == dots_to_slashes (moduleNameUserString mod) loc <- hiOnlyModLocation path basename hisuf - let result = (mkHomeModule mod_name, loc) - addToFinderCache mod_name result - return result + addToFinderCache mod (loc, Nothing) + return (Found loc ThisPackage) -mkPackageModLocation hisuf mod_name path basename _extension = do +mkPackageModLocation pkg_info hisuf mod path basename _ext = do + -- basename == dots_to_slashes (moduleNameUserString mod) loc <- hiOnlyModLocation path basename hisuf - let result = (mkPackageModule mod_name, loc) - addToFinderCache mod_name result - return result + addToFinderCache mod (loc, pkg_info) + return (Found loc (pkgInfoToId pkg_info)) hiOnlyModLocation path basename hisuf - = do { obj_fn <- mkObjPath path basename ; - return (ModLocation{ ml_hspp_file = Nothing, + = do let full_basename = path++'/':basename + obj_fn <- mkObjPath full_basename 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_hi_file = full_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 - - hisuf <- readIORef v_Hi_suf - hidir <- readIORef v_Hi_dir - - obj_fn <- mkObjPath path basename - - let -- hi filename - mod_str = moduleNameUserString mod_name - (_,mod_suf) = split_longest_prefix mod_str (=='.') +-- Parameters are: +-- +-- mod +-- 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) +-- (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 src_filename = do + let (basename,extension) = splitFilename src_filename + mkHomeModLocation' mod basename extension + +mkHomeModLocationSearched mod path basename ext = do + loc <- mkHomeModLocation' mod (path ++ '/':basename) ext + return (Found loc ThisPackage) + +mkHomeModLocation' mod src_basename ext = do + let mod_basename = dots_to_slashes (moduleUserString mod) + + obj_fn <- mkObjPath src_basename mod_basename + hi_fn <- mkHiPath src_basename mod_basename + + let loc = ModLocation{ ml_hspp_file = Nothing, + ml_hs_file = Just (src_basename ++ '.':ext), + ml_hi_file = hi_fn, + ml_obj_file = obj_fn } + + addToFinderCache mod (loc, Nothing) + return loc + +-- | Constructs the filename of a .o file for a given source file. +-- Does /not/ check whether the .o file exists +mkObjPath + :: FilePath -- the filename of the source file, minus the extension + -> String -- the module name with dots replaced by slashes + -> IO FilePath +mkObjPath basename mod_basename + = do odir <- readIORef v_Output_dir + osuf <- readIORef v_Object_suf - hi_basename - | is_root = mod_suf - | otherwise = basename + let obj_basename | Just dir <- odir = dir ++ '/':mod_basename + | otherwise = basename - hi_path | Just d <- hidir = d - | otherwise = path - hi_fn = hi_path ++ '/':hi_basename ++ '.':hisuf + return (obj_basename ++ '.':osuf) - -- source filename (extension is always .hs or .lhs) - source_fn - | path == "." = basename ++ '.':extension - | otherwise = path ++ '/':basename ++ '.':extension +-- | Constructs the filename of a .hi file for a given source file. +-- Does /not/ check whether the .hi file exists +mkHiPath + :: FilePath -- the filename of the source file, minus the extension + -> String -- the module name with dots replaced by slashes + -> IO FilePath +mkHiPath basename mod_basename + = do hidir <- readIORef v_Hi_dir + hisuf <- readIORef v_Hi_suf - result = ( mkHomeModule mod_name, - ModLocation{ ml_hspp_file = Nothing, - ml_hs_file = Just source_fn, - ml_hi_file = hi_fn, - ml_obj_file = obj_fn, - }) + let hi_basename | Just dir <- hidir = dir ++ '/':mod_basename + | otherwise = basename - 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) - - + return (hi_basename ++ '.':hisuf) -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, --- but there' no other obvious place for it +-- but there's no other obvious place for it -findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable) +findLinkable :: Module -> ModLocation -> IO (Maybe Linkable) findLinkable mod locn = do let obj_fn = ml_obj_file locn obj_exist <- doesFileExist obj_fn @@ -336,4 +392,10 @@ 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])) + +-- ----------------------------------------------------------------------------- +-- Utils + +dots_to_slashes = map (\c -> if c == '.' then '/' else c) + \end{code}