{- (c) The University of Glasgow, 2000-2006 -} {-# LANGUAGE FlexibleContexts #-} -- | Module finder module GHC.Unit.Finder ( FindResult(..), InstalledFindResult(..), FinderOpts(..), FinderCache, initFinderCache, flushFinderCaches, findImportedModule, findPluginModule, findExactModule, findHomeModule, findExposedPackageModule, mkHomeModLocation, mkHomeModLocation2, mkHiOnlyModLocation, mkHiPath, mkObjPath, addHomeModuleToFinder, uncacheModule, mkStubPaths, findObjectLinkableMaybe, findObjectLinkable, -- Hash cache lookupFileCache ) where import GHC.Prelude import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) import GHC.Unit.Types import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State import GHC.Unit.Finder.Types import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.ShortText as ST import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Linker.Types import GHC.Fingerprint import Data.IORef import System.Directory import System.FilePath import Control.Monad import Data.Time import qualified Data.Map as M type FileExt = String -- Filename extension type BaseName = String -- Basename of file -- ----------------------------------------------------------------------------- -- The Finder -- 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. Use -- Packages.lookupModuleInAllUnits for that. -- ----------------------------------------------------------------------------- -- The finder's cache initFinderCache :: IO FinderCache initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv <*> newIORef M.empty -- remove all the home modules from the cache; package modules are -- assumed to not move around during a session; also flush the file hash -- cache flushFinderCaches :: FinderCache -> HomeUnit -> IO () flushFinderCaches (FinderCache ref file_ref) home_unit = do atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ()) atomicModifyIORef' file_ref $ \_ -> (M.empty, ()) where is_ext mod _ = not (isHomeInstalledModule home_unit mod) addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO () addToFinderCache (FinderCache ref _) key val = atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ()) removeFromFinderCache :: FinderCache -> InstalledModule -> IO () removeFromFinderCache (FinderCache ref _) key = atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ()) lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult) lookupFinderCache (FinderCache ref _) key = do c <- readIORef ref return $! lookupInstalledModuleEnv c key lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint lookupFileCache (FinderCache _ ref) key = do c <- readIORef ref case M.lookup key c of Nothing -> do hash <- getFileHash key atomicModifyIORef' ref $ \c -> (M.insert key hash c, ()) return hash Just fp -> return fp -- ----------------------------------------------------------------------------- -- The three external entry points -- | Locations and information the finder cares about. -- -- Should be taken from 'DynFlags' via 'initFinderOpts'. data FinderOpts = FinderOpts { finder_importPaths :: [FilePath] -- ^ Where are we allowed to look for Modules and Source files , finder_lookupHomeInterfaces :: Bool -- ^ When looking up a home module: -- -- * 'True': search interface files (e.g. in '-c' mode) -- * 'False': search source files (e.g. in '--make' mode) , finder_bypassHiFileCheck :: Bool -- ^ Don't check that an imported interface file actually exists -- if it can only be at one location. The interface will be reported -- as `InstalledFound` even if the file doesn't exist, so this is -- only useful in specific cases (e.g. to generate dependencies -- with `ghc -M`) , finder_ways :: Ways , finder_enableSuggestions :: Bool -- ^ If we encounter unknown modules, should we suggest modules -- that have a similar name. , finder_hieDir :: Maybe FilePath , finder_hieSuf :: String , finder_hiDir :: Maybe FilePath , finder_hiSuf :: String , finder_objectDir :: Maybe FilePath , finder_objectSuf :: String , finder_stubDir :: Maybe FilePath } -- | Locate a module that was imported by the user. We have the -- module's name, and possibly a package name. Without a package -- name, this function will use the search path and the known exposed -- packages to find the module, if a package is specified then only -- that package is searched for the module. findImportedModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> ModuleName -> Maybe FastString -> IO FindResult findImportedModule fc fopts units home_unit mod_name mb_pkg = case mb_pkg of Nothing -> unqual_import Just pkg | pkg == fsLit "this" -> home_import -- "this" is special | otherwise -> pkg_import where home_import = findHomeModule fc fopts home_unit mod_name pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg unqual_import = home_import `orIfNotFound` findExposedPackageModule fc fopts units mod_name Nothing -- | Locate a plugin module requested by the user, for a compiler -- plugin. This consults the same set of exposed packages as -- 'findImportedModule', unless @-hide-all-plugin-packages@ or -- @-plugin-package@ are specified. findPluginModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> ModuleName -> IO FindResult findPluginModule fc fopts units home_unit mod_name = findHomeModule fc fopts home_unit mod_name `orIfNotFound` findExposedPluginPackageModule fc fopts units mod_name -- | Locate a specific 'Module'. The purpose of this function is to -- create a 'ModLocation' for a given 'Module', that is to find out -- where the files associated with this module live. It is used when -- reading the interface for a module mentioned by another interface, -- for example (a "system import"). findExactModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult findExactModule fc fopts unit_state home_unit mod = do if isHomeInstalledModule home_unit mod then findInstalledHomeModule fc fopts home_unit (moduleName mod) else findPackageModule fc unit_state fopts mod -- ----------------------------------------------------------------------------- -- Helpers -- | Given a monadic actions @this@ and @or_this@, first execute -- @this@. If the returned 'FindResult' is successful, return -- it; otherwise, execute @or_this@. If both failed, this function -- also combines their failure messages in a reasonable way. orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult orIfNotFound this or_this = do res <- this case res of NotFound { fr_paths = paths1, fr_mods_hidden = mh1 , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 } -> do res2 <- or_this case res2 of NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2 , fr_pkgs_hidden = ph2, fr_unusables = u2 , fr_suggestions = s2 } -> return (NotFound { fr_paths = paths1 ++ paths2 , fr_pkg = mb_pkg2 -- snd arg is the package search , fr_mods_hidden = mh1 ++ mh2 , fr_pkgs_hidden = ph1 ++ ph2 , fr_unusables = u1 ++ u2 , fr_suggestions = s1 ++ s2 }) _other -> return res2 _other -> return res -- | Helper function for 'findHomeModule': this function wraps an IO action -- which would look up @mod_name@ in the file system (the home package), -- and first consults the 'hsc_FC' cache to see if the lookup has already -- been done. Otherwise, do the lookup (with the IO action) and save -- the result in the finder cache and the module location cache (if it -- was successful.) homeSearchCache :: FinderCache -> HomeUnit -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult homeSearchCache fc home_unit mod_name do_this = do let mod = mkHomeInstalledModule home_unit mod_name modLocationCache fc mod do_this findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> Maybe FastString -> IO FindResult findExposedPackageModule fc fopts units mod_name mb_pkg = findLookupResult fc fopts $ lookupModuleWithSuggestions units mod_name mb_pkg findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult findExposedPluginPackageModule fc fopts units mod_name = findLookupResult fc fopts $ lookupPluginModuleWithSuggestions units mod_name Nothing findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult findLookupResult fc fopts r = case r of LookupFound m pkg_conf -> do let im = fst (getModuleInstantiation m) r' <- findPackageModule_ fc fopts im (fst pkg_conf) case r' of -- TODO: ghc -M is unlikely to do the right thing -- with just the location of the thing that was -- instantiated; you probably also need all of the -- implicit locations from the instances InstalledFound loc _ -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] , fr_suggestions = []}) LookupMultiple rs -> return (FoundMultiple rs) LookupHidden pkg_hiddens mod_hiddens -> return (NotFound{ fr_paths = [], fr_pkg = Nothing , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens , fr_unusables = [] , fr_suggestions = [] }) LookupUnusable unusable -> let unusables' = map get_unusable unusable get_unusable (m, ModUnusable r) = (moduleUnit m, r) get_unusable (_, r) = pprPanic "findLookupResult: unexpected origin" (ppr r) in return (NotFound{ fr_paths = [], fr_pkg = Nothing , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = unusables' , fr_suggestions = [] }) LookupNotFound suggest -> do let suggest' | finder_enableSuggestions fopts = suggest | otherwise = [] return (NotFound{ fr_paths = [], fr_pkg = Nothing , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_unusables = [] , fr_suggestions = suggest' }) modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult modLocationCache fc mod do_this = do m <- lookupFinderCache fc mod case m of Just result -> return result Nothing -> do result <- do_this addToFinderCache fc mod result return result -- This returns a module because it's more convenient for users addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module addHomeModuleToFinder fc home_unit mod_name loc = do let mod = mkHomeInstalledModule home_unit mod_name addToFinderCache fc mod (InstalledFound loc mod) return (mkHomeModule home_unit mod_name) uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO () uncacheModule fc home_unit mod_name = do let mod = mkHomeInstalledModule home_unit mod_name removeFromFinderCache fc mod -- ----------------------------------------------------------------------------- -- The internal workers findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult findHomeModule fc fopts home_unit mod_name = do let uid = homeUnitAsUnit home_unit r <- findInstalledHomeModule fc fopts home_unit mod_name return $ case r of InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { fr_paths = fps, fr_pkg = Just uid, fr_mods_hidden = [], fr_pkgs_hidden = [], fr_unusables = [], fr_suggestions = [] } -- | Implements the search for a module name in the home package only. Calling -- this function directly is usually *not* what you want; currently, it's used -- as a building block for the following operations: -- -- 1. When you do a normal package lookup, we first check if the module -- is available in the home module, before looking it up in the package -- database. -- -- 2. When you have a package qualified import with package name "this", -- we shortcut to the home module. -- -- 3. When we look up an exact 'Module', if the unit id associated with -- the module is the current home module do a look up in the home module. -- -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to -- call this.) findInstalledHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO InstalledFindResult findInstalledHomeModule fc fopts home_unit mod_name = do homeSearchCache fc home_unit mod_name $ let home_path = finder_importPaths fopts hisuf = finder_hiSuf fopts mod = mkHomeInstalledModule home_unit mod_name source_exts = [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that -- when hiDir field is set in dflags, we know to look there (see #16500) hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name) , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts 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. exts | finder_lookupHomeInterfaces fopts = hi_exts | otherwise = source_exts in -- special case for GHC.Prim; we won't find it in the filesystem. -- This is important only when compiling the base package (where GHC.Prim -- is a home module). if mod `installedModuleEq` gHC_PRIM then return (InstalledFound (error "GHC.Prim ModLocation") mod) else searchPathExts home_path mod exts -- | Search for a module in external packages only. findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult findPackageModule fc unit_state fopts mod = do let pkg_id = moduleUnit mod case lookupUnitId unit_state pkg_id of Nothing -> return (InstalledNoPackage pkg_id) Just u -> findPackageModule_ fc fopts mod u -- | Look up the interface file associated with module @mod@. This function -- requires a few invariants to be upheld: (1) the 'Module' in question must -- be the module identifier of the *original* implementation of a module, -- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2) -- the 'UnitInfo' must be consistent with the unit id in the 'Module'. -- The redundancy is to avoid an extra lookup in the package state -- for the appropriate config. findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult findPackageModule_ fc fopts mod pkg_conf = do massertPpr (moduleUnit mod == unitId pkg_conf) (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf)) modLocationCache fc mod $ -- special case for GHC.Prim; we won't find it in the filesystem. if mod `installedModuleEq` gHC_PRIM then return (InstalledFound (error "GHC.Prim ModLocation") mod) else let tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. package_hisuf | null tag = "hi" | otherwise = tag ++ "_hi" mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf import_dirs = map ST.unpack $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in case import_dirs of [one] | finder_bypassHiFileCheck fopts -> do -- there's only one place that this .hi file can be, so -- don't bother looking for it. let basename = moduleNameSlashes (moduleName mod) loc <- mk_hi_loc one basename return (InstalledFound loc mod) _otherwise -> searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)] -- ----------------------------------------------------------------------------- -- General path searching searchPathExts :: [FilePath] -- paths to search -> InstalledModule -- module name -> [ ( FileExt, -- suffix FilePath -> BaseName -> IO ModLocation -- action ) ] -> IO InstalledFindResult searchPathExts paths mod exts = search to_search where basename = moduleNameSlashes (moduleName mod) to_search :: [(FilePath, IO ModLocation)] to_search = [ (file, fn path basename) | path <- paths, (ext,fn) <- exts, let base | path == "." = basename | otherwise = path basename file = base <.> ext ] search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod))) search ((file, mk_result) : rest) = do b <- doesFileExist file if b then do { loc <- mk_result; return (InstalledFound loc mod) } else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt -> FilePath -> BaseName -> IO ModLocation mkHomeModLocationSearched fopts mod suff path basename = mkHomeModLocation2 fopts mod (path basename) suff -- ----------------------------------------------------------------------------- -- 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 -- The name of the module -- -- path -- (a): The search path component where the source file was found. -- (b) and (c): "." -- -- src_basename -- (a): (moduleNameSlashes 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 :: FinderOpts -> ModuleName -> FilePath -> IO ModLocation mkHomeModLocation dflags mod src_filename = do let (basename,extension) = splitExtension src_filename mkHomeModLocation2 dflags mod basename extension mkHomeModLocation2 :: FinderOpts -> ModuleName -> FilePath -- Of source module, without suffix -> String -- Suffix -> IO ModLocation mkHomeModLocation2 fopts mod src_basename ext = do let mod_basename = moduleNameSlashes mod obj_fn = mkObjPath fopts src_basename mod_basename hi_fn = mkHiPath fopts src_basename mod_basename hie_fn = mkHiePath fopts src_basename mod_basename return (ModLocation{ ml_hs_file = Just (src_basename <.> ext), ml_hi_file = hi_fn, ml_obj_file = obj_fn, ml_hie_file = hie_fn }) mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName -> FilePath -> BaseName -> IO ModLocation mkHomeModHiOnlyLocation fopts mod path basename = do loc <- mkHomeModLocation2 fopts mod (path basename) "" return loc { ml_hs_file = Nothing } mkHiOnlyModLocation :: FinderOpts -> Suffix -> FilePath -> String -> IO ModLocation mkHiOnlyModLocation fopts hisuf path basename = do let full_basename = path basename obj_fn = mkObjPath fopts full_basename basename hie_fn = mkHiePath fopts full_basename basename return ModLocation{ ml_hs_file = Nothing, 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, ml_hie_file = hie_fn } -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath mkObjPath fopts basename mod_basename = obj_basename <.> osuf where odir = finder_objectDir fopts osuf = finder_objectSuf fopts obj_basename | Just dir <- odir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hi file for a given source file. -- Does /not/ check whether the .hi file exists mkHiPath :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where hidir = finder_hiDir fopts hisuf = finder_hiSuf fopts hi_basename | Just dir <- hidir = dir mod_basename | otherwise = basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where hiedir = finder_hieDir fopts hiesuf = finder_hieSuf fopts hie_basename | Just dir <- hiedir = dir mod_basename | otherwise = basename -- ----------------------------------------------------------------------------- -- Filenames of the stub files -- We don't have to store these in ModLocations, because they can be derived -- from other available information, and they're only rarely needed. mkStubPaths :: FinderOpts -> ModuleName -> ModLocation -> FilePath mkStubPaths fopts mod location = let stubdir = finder_stubDir fopts mod_basename = moduleNameSlashes mod src_basename = dropExtension $ expectJust "mkStubPaths" (ml_hs_file location) stub_basename0 | Just dir <- stubdir = dir mod_basename | otherwise = src_basename stub_basename = stub_basename0 ++ "_stub" in stub_basename <.> "h" -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, -- but there's no other obvious place for it findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable) findObjectLinkableMaybe mod locn = do let obj_fn = ml_obj_file locn maybe_obj_time <- modificationTimeIfExists obj_fn case maybe_obj_time of Nothing -> return Nothing Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time) -- Make an object linkable when we know the object file exists, and we know -- its modification time. findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn]) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687)