X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FFinder.lhs;h=f3c859762ac7a6ca785c5e8e2e592f7b50179fe6;hb=2d532e45924dfdb5b5157caf4d3fc3541497d86c;hp=f8f2a7181d06ded2d78da1490a69de725ad863ac;hpb=9af77fa423926fbda946b31e174173d0ec5ebac8;p=ghc-hetmet.git diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index f8f2a71..f3c8597 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -5,155 +5,152 @@ \begin{code} module Finder ( - initFinder, -- :: [PackageConfig] -> IO (), - findModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) - findModuleDep, -- :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) - findPackageModule, -- :: ModuleName -> IO (Maybe (Module, ModLocation)) - mkHomeModuleLocn, -- :: ModuleName -> String -> FilePath - -- -> IO ModLocation - emptyHomeDirCache, -- :: IO () - flushPackageCache -- :: [PackageConfig] -> IO () + flushFinderCache, -- :: IO () + + findModule, -- :: ModuleName + -- -> IO (Either [FilePath] (Module, ModLocation)) + + findPackageModule, -- :: ModuleName + -- -> IO (Either [FilePath] (Module, ModLocation)) + + mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation + + findLinkable, -- :: ModuleName -> ModLocation -> IO (Maybe Linkable) + + hiBootExt, -- :: String + hiBootVerExt, -- :: String + ) where #include "HsVersions.h" -import Module ( Module, ModLocation(..), ModuleName, - moduleNameUserString, mkHomeModule, mkPackageModule - ) -import Packages ( PackageConfig(..) ) -import DriverPhases +import Module +import UniqFM ( filterUFM ) +import HscTypes ( Linkable(..), Unlinked(..) ) import DriverState import DriverUtil import FastString import Config +import Util -import DATA_IOREF ( readIORef ) +import DATA_IOREF ( IORef, writeIORef, readIORef ) import List import Directory import IO import Monad -\end{code} - -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. - -It does *not* know which particular package a module lives in, because -that information is only contained in the interface file. - -\begin{code} -initFinder :: [PackageConfig] -> IO () -initFinder pkgs = return () - --- empty, and lazilly fill in the package cache -flushPackageCache :: [PackageConfig] -> IO () -flushPackageCache pkgs = return () - -emptyHomeDirCache :: IO () -emptyHomeDirCache = return () - -findModule :: ModuleName -> IO (Maybe (Module, ModLocation)) -findModule name = findModuleDep name False - -findModuleDep :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) -findModuleDep name is_source - = do { j <- maybeHomeModule name is_source - ; case j of - Just home_module -> return (Just home_module) - Nothing -> findPackageMod name False is_source - } -maybeHomeModule :: ModuleName -> Bool -> IO (Maybe (Module, ModLocation)) -maybeHomeModule mod_name is_source = do +-- ----------------------------------------------------------------------------- +-- 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. +-- +-- It does *not* know which particular package a module lives in, because +-- that information is only contained in the interface file. + +-- ----------------------------------------------------------------------------- +-- The finder's cache + +GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation)) + +-- 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) + +addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO () +addToFinderCache mod_name stuff = do + fm <- readIORef finder_cache + writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff) + +lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation)) +lookupFinderCache mod_name = do + fm <- readIORef finder_cache + return $! lookupModuleEnvByName fm mod_name + +-- ----------------------------------------------------------------------------- +-- Locating modules + +-- This is the main interface to the finder, which maps ModuleNames to +-- Modules and ModLocations. +-- +-- The Module contains one crucial bit of information about a module: +-- whether it lives in the current ("home") package or not (see Module +-- for more details). +-- +-- The ModLocation contains the names of all the files associated with +-- that module: its source file, .hi file, object file, etc. + +findModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) +findModule name = do + r <- lookupFinderCache name + case r of + Just result -> return (Right result) + Nothing -> do + j <- maybeHomeModule name + case j of + 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 (Right result) + Nothing -> findPackageMod name + +hiBootExt = "hi-boot" +hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion + +maybeHomeModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) +maybeHomeModule mod_name = do home_path <- readIORef v_Import_paths hisuf <- readIORef v_Hi_suf mode <- readIORef v_GhcMode - let mod_str = moduleNameUserString mod_name - basename = map (\c -> if c == '.' then '/' else c) mod_str - - -- 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 files only. - -- - -- When generating dependencies, we're interested in either category. - -- - source_exts = - [ ("hs", \ fName path -> mkHomeModuleLocn mod_name path fName) - , ("lhs", \ fName path -> mkHomeModuleLocn mod_name path fName) - ] - hi_exts = [ (hisuf, \ fName path -> mkHiOnlyModuleLocn mod_name fName) ] - - std_exts - | mode == DoMkDependHS = hi_exts ++ source_exts + let + source_exts = + [ ("hs", mkHomeModLocationSearched mod_name) + , ("lhs", mkHomeModLocationSearched mod_name) + ] + + hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ] + + boot_exts = + [ (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. + -- + -- When generating dependencies, we're interested in either category. + -- + exts + | mode == DoMkDependHS = hi_exts ++ source_exts ++ boot_exts | isCompManagerMode mode = source_exts - | otherwise = hi_exts + | otherwise {-one-shot-} = hi_exts ++ boot_exts - -- last chance: .hi-boot- and .hi-boot - hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion - - boot_exts = - [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName) - , ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName) - ] - - searchPathExts home_path basename - (if is_source then boot_exts else (std_exts ++ boot_exts)) - -- for SOURCE imports, check the hi-boot extensions - -- before the source/iface ones, to avoid - -- creating circ Makefile deps. + searchPathExts home_path mod_name exts +-- ----------------------------------------------------------------------------- +-- Looking for a package module -mkHiOnlyModuleLocn mod_name hi_file = - return - ( mkHomeModule mod_name - , ModLocation{ ml_hspp_file = Nothing - , ml_hs_file = Nothing - , ml_hi_file = hi_file - , ml_obj_file = 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 -- everything but the extension - source_fn -- full path to the source (required) - = do - - hisuf <- readIORef v_Hi_suf - hidir <- readIORef v_Hi_dir - - -- take the *last* component of the module name (if a hierarchical name), - -- and append it to the directory to get the .hi file name. - let (_,mod_str) = split_longest_prefix (moduleNameUserString mod_name) (=='.') - hi_filename = mod_str ++ '.':hisuf - hi_path | Just d <- hidir = d - | otherwise = getdir basename - hi = hi_path ++ '/':hi_filename - - -- figure out the .o file name. It also lives in the same dir - -- as the source, but can be overriden by a -odir flag. - o_file <- odir_ify (basename ++ '.':phaseInputExt Ln) >>= osuf_ify - - return (mkHomeModule mod_name, - ModLocation{ ml_hspp_file = Nothing - , ml_hs_file = Just source_fn - , ml_hi_file = hi - , ml_obj_file = Just o_file - }) - -findPackageMod :: ModuleName - -> Bool - -> Bool - -> IO (Maybe (Module, ModLocation)) -findPackageMod mod_name hiOnly is_source = do - pkgs <- getPackageInfo +findPackageMod :: ModuleName -> IO (Either [FilePath] (Module, ModLocation)) +findPackageMod mod_name = do + mode <- readIORef v_GhcMode + imp_dirs <- getPackageImportPath -- including the 'auto' ones -- hi-suffix for packages depends on the build tag. package_hisuf <- @@ -161,55 +158,199 @@ findPackageMod mod_name hiOnly is_source = do if null tag then return "hi" else return (tag ++ "_hi") - let imp_dirs = concatMap import_dirs pkgs - mod_str = moduleNameUserString mod_name - basename = map (\c -> if c == '.' then '/' else c) mod_str - - retPackageModule mod_name mbFName path = - return ( mkPackageModule mod_name - , ModLocation{ ml_hspp_file = Nothing - , ml_hs_file = mbFName - , ml_hi_file = path ++ '.':package_hisuf - , ml_obj_file = Nothing - }) - - -- last chance: .hi-boot- and .hi-boot - hi_boot_ver = "hi-boot-" ++ cHscIfaceFileVersion - - boot_exts = - [ (hi_boot_ver, \ fName path -> mkHiOnlyModuleLocn mod_name fName) - , ("hi-boot", \ fName path -> mkHiOnlyModuleLocn mod_name fName) - ] - - searchPathExts - imp_dirs basename - (if is_source then boot_exts else - ((package_hisuf,\ fName path -> retPackageModule mod_name Nothing path) : - (if hiOnly then [] else - [ ("hs", \ fName path -> retPackageModule mod_name (Just fName) path) - , ("lhs", \ fName path -> retPackageModule mod_name (Just fName) path) - ]))) - where - -findPackageModule :: ModuleName -> IO (Maybe (Module, ModLocation)) -findPackageModule mod_name = findPackageMod mod_name True False - -searchPathExts :: [FilePath] - -> String - -> [(String, FilePath -> String -> IO (Module, ModLocation))] - -> IO (Maybe (Module, ModLocation)) -searchPathExts path basename exts = search path + + let + hi_exts = + [ (package_hisuf, mkPackageModLocation package_hisuf mod_name) ] + + source_exts = + [ ("hs", mkPackageModLocation package_hisuf mod_name) + , ("lhs", mkPackageModLocation package_hisuf mod_name) + ] + + -- mkdependHS needs to look for source files in packages too, so + -- that we can make dependencies between package before they have + -- been built. + exts + | mode == DoMkDependHS = hi_exts ++ source_exts + | otherwise = hi_exts + + -- 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 + +-- ----------------------------------------------------------------------------- +-- General path searching + +searchPathExts + :: [FilePath] -- paths to search + -> ModuleName -- module name + -> [ ( + String, -- suffix + String -> String -> String -> IO (Module, ModLocation) -- action + ) + ] + -> IO (Either [FilePath] (Module, ModLocation)) + +searchPathExts path mod_name exts = search to_search where - 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 file base - 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 _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 + +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 + +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 + +-- 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: +-- +-- (a) Here in the finder, when we are searching for a module to import, +-- using the search path (-i option). +-- +-- (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). +-- +-- (c) The driver in one-shot mode, when we need to construct a +-- ModLocation for a source file named on the command-line. +-- +-- 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 + + let mod_basename = dots_to_slashes (moduleNameUserString mod_name) + + 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 ++ '/':mod_basename ++ '.':hisuf + + -- 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 = 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}