2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
16 addHomeModuleToFinder,
20 findObjectLinkableMaybe,
28 #include "HsVersions.h"
35 import PrelNames ( gHC_PRIM )
36 import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) )
40 import Maybes ( expectJust )
42 import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
44 import System.Directory
47 import System.Time ( ClockTime )
50 type FileExt = String -- Filename extension
51 type BaseName = String -- Basename of file
53 -- -----------------------------------------------------------------------------
56 -- The Finder provides a thin filesystem abstraction to the rest of
57 -- the compiler. For a given module, it can tell you where the
58 -- source, interface, and object files for that module live.
60 -- It does *not* know which particular package a module lives in. Use
61 -- Packages.lookupModuleInAllPackages for that.
63 -- -----------------------------------------------------------------------------
66 -- remove all the home modules from the cache; package modules are
67 -- assumed to not move around during a session.
68 flushFinderCaches :: HscEnv -> IO ()
69 flushFinderCaches hsc_env = do
70 writeIORef fc_ref emptyUFM
71 flushModLocationCache this_pkg mlc_ref
73 this_pkg = thisPackage (hsc_dflags hsc_env)
74 fc_ref = hsc_FC hsc_env
75 mlc_ref = hsc_MLC hsc_env
77 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
78 flushModLocationCache this_pkg ref = do
80 writeIORef ref $! filterFM is_ext fm
82 where is_ext mod _ | modulePackageId mod /= this_pkg = True
85 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
86 addToFinderCache ref key val = modifyIORef ref $ \c -> addToUFM c key val
88 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
89 addToModLocationCache ref key val = modifyIORef ref $ \c -> addToFM c key val
91 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
92 removeFromFinderCache ref key = modifyIORef ref $ \c -> delFromUFM c key
94 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
95 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
97 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
98 lookupFinderCache ref key = do
100 return $! lookupUFM c key
102 lookupModLocationCache :: IORef ModLocationCache -> Module
103 -> IO (Maybe ModLocation)
104 lookupModLocationCache ref key = do
106 return $! lookupFM c key
108 -- -----------------------------------------------------------------------------
109 -- The two external entry points
111 -- | Locate a module that was imported by the user. We have the
112 -- module's name, and possibly a package name. Without a package
113 -- name, this function will use the search path and the known exposed
114 -- packages to find the module, if a package is specified then only
115 -- that package is searched for the module.
117 findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
118 findImportedModule hsc_env mod_name mb_pkgid =
120 Nothing -> unqual_import
121 Just pkg | pkg == this_pkg -> home_import
122 | otherwise -> pkg_import pkg
124 dflags = hsc_dflags hsc_env
125 this_pkg = thisPackage dflags
127 home_import = findHomeModule hsc_env mod_name
129 pkg_import pkg = findPackageModule hsc_env (mkModule pkg mod_name)
130 -- ToDo: this isn't quite right, the module we want
131 -- might actually be in another package, but re-exposed
132 -- ToDo: should return NotFoundInPackage if
133 -- the module isn't exposed by the package.
135 unqual_import = home_import
137 findExposedPackageModule hsc_env mod_name
139 -- | Locate a specific 'Module'. The purpose of this function is to
140 -- create a 'ModLocation' for a given 'Module', that is to find out
141 -- where the files associated with this module live. It is used when
142 -- reading the interface for a module mentioned by another interface,
143 -- for example (a "system import").
145 findExactModule :: HscEnv -> Module -> IO FindResult
146 findExactModule hsc_env mod =
147 let dflags = hsc_dflags hsc_env in
148 if modulePackageId mod == thisPackage dflags
149 then findHomeModule hsc_env (moduleName mod)
150 else findPackageModule hsc_env mod
152 -- -----------------------------------------------------------------------------
155 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
156 this `orIfNotFound` or_this = do
159 NotFound here _ -> do
162 NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
163 _other -> return res2
167 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
168 homeSearchCache hsc_env mod_name do_this = do
169 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
171 Just result -> return result
174 addToFinderCache (hsc_FC hsc_env) mod_name result
176 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
180 findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
181 findExposedPackageModule hsc_env mod_name
182 -- not found in any package:
183 | null found = return (NotFound [] Nothing)
184 -- found in just one exposed package:
185 | [(pkg_conf, _)] <- found_exposed
186 = let pkgid = mkPackageId (package pkg_conf) in
187 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
188 -- not found in any exposed package, report how it was hidden:
189 | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
190 = let pkgid = mkPackageId (package pkg_conf) in
192 then return (ModuleHidden pkgid)
193 else return (PackageHidden pkgid)
195 = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
197 dflags = hsc_dflags hsc_env
198 found = lookupModuleInAllPackages dflags mod_name
199 found_exposed = filter is_exposed found
200 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
203 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
204 modLocationCache hsc_env mod do_this = do
205 mb_loc <- lookupModLocationCache mlc mod
207 Just loc -> return (Found loc mod)
211 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
215 mlc = hsc_MLC hsc_env
217 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
218 addHomeModuleToFinder hsc_env mod_name loc = do
219 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
220 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
221 addToModLocationCache (hsc_MLC hsc_env) mod loc
224 uncacheModule :: HscEnv -> ModuleName -> IO ()
225 uncacheModule hsc_env mod = do
226 let this_pkg = thisPackage (hsc_dflags hsc_env)
227 removeFromFinderCache (hsc_FC hsc_env) mod
228 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
230 -- -----------------------------------------------------------------------------
231 -- The internal workers
233 -- | Search for a module in the home package only.
234 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
235 findHomeModule hsc_env mod_name =
236 homeSearchCache hsc_env mod_name $
238 dflags = hsc_dflags hsc_env
239 home_path = importPaths dflags
241 mod = mkModule (thisPackage dflags) mod_name
244 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
245 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
248 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
249 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
252 -- In compilation manager modes, we look for source files in the home
253 -- package because we can compile these automatically. In one-shot
254 -- compilation mode we look for .hi and .hi-boot files only.
255 exts | isOneShot (ghcMode dflags) = hi_exts
256 | otherwise = source_exts
259 -- special case for GHC.Prim; we won't find it in the filesystem.
260 -- This is important only when compiling the base package (where GHC.Prim
261 -- is a home module).
263 then return (Found (error "GHC.Prim ModLocation") mod)
266 searchPathExts home_path mod exts
269 -- | Search for a module in external packages only.
270 findPackageModule :: HscEnv -> Module -> IO FindResult
271 findPackageModule hsc_env mod = do
273 dflags = hsc_dflags hsc_env
274 pkg_id = modulePackageId mod
275 pkg_map = pkgIdMap (pkgState dflags)
277 case lookupPackage pkg_map pkg_id of
278 Nothing -> return (NoPackage pkg_id)
279 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
281 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
282 findPackageModule_ hsc_env mod pkg_conf =
283 modLocationCache hsc_env mod $
285 -- special case for GHC.Prim; we won't find it in the filesystem.
287 then return (Found (error "GHC.Prim ModLocation") mod)
291 dflags = hsc_dflags hsc_env
292 tag = buildTag dflags
294 -- hi-suffix for packages depends on the build tag.
295 package_hisuf | null tag = "hi"
296 | otherwise = tag ++ "_hi"
298 [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
301 [ ("hs", mkHiOnlyModLocation dflags package_hisuf)
302 , ("lhs", mkHiOnlyModLocation dflags package_hisuf)
305 -- mkdependHS needs to look for source files in packages too, so
306 -- that we can make dependencies between package before they have
309 | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
310 | otherwise = hi_exts
311 -- we never look for a .hi-boot file in an external package;
312 -- .hi-boot files only make sense for the home package.
314 searchPathExts (importDirs pkg_conf) mod exts
316 -- -----------------------------------------------------------------------------
317 -- General path searching
320 :: [FilePath] -- paths to search
321 -> Module -- module name
324 FilePath -> BaseName -> IO ModLocation -- action
329 searchPathExts paths mod exts
330 = do result <- search to_search
332 hPutStrLn stderr (showSDoc $
333 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
334 , nest 2 (vcat (map text paths))
336 Succeeded (loc, p) -> text "Found" <+> ppr loc
337 Failed fs -> text "not found"])
342 basename = moduleNameSlashes (moduleName mod)
344 to_search :: [(FilePath, IO ModLocation)]
345 to_search = [ (file, fn path basename)
348 let base | path == "." = basename
349 | otherwise = path `joinFileName` basename
350 file = base `joinFileExt` ext
353 search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
354 search ((file, mk_result) : rest) = do
355 b <- doesFileExist file
357 then do { loc <- mk_result; return (Found loc mod) }
360 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
361 -> FilePath -> BaseName -> IO ModLocation
362 mkHomeModLocationSearched dflags mod suff path basename = do
363 mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
365 -- -----------------------------------------------------------------------------
366 -- Constructing a home module location
368 -- This is where we construct the ModLocation for a module in the home
369 -- package, for which we have a source file. It is called from three
372 -- (a) Here in the finder, when we are searching for a module to import,
373 -- using the search path (-i option).
375 -- (b) The compilation manager, when constructing the ModLocation for
376 -- a "root" module (a source file named explicitly on the command line
377 -- or in a :load command in GHCi).
379 -- (c) The driver in one-shot mode, when we need to construct a
380 -- ModLocation for a source file named on the command-line.
385 -- The name of the module
388 -- (a): The search path component where the source file was found.
392 -- (a): (moduleNameSlashes mod)
393 -- (b) and (c): The filename of the source file, minus its extension
396 -- The filename extension of the source file (usually "hs" or "lhs").
398 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
399 mkHomeModLocation dflags mod src_filename = do
400 let (basename,extension) = splitFilename src_filename
401 mkHomeModLocation2 dflags mod basename extension
403 mkHomeModLocation2 :: DynFlags
405 -> FilePath -- Of source module, without suffix
408 mkHomeModLocation2 dflags mod src_basename ext = do
409 let mod_basename = moduleNameSlashes mod
411 obj_fn <- mkObjPath dflags src_basename mod_basename
412 hi_fn <- mkHiPath dflags src_basename mod_basename
414 return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
416 ml_obj_file = obj_fn })
418 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
420 mkHiOnlyModLocation dflags hisuf path basename
421 = do let full_basename = path `joinFileName` basename
422 obj_fn <- mkObjPath dflags full_basename basename
423 return ModLocation{ ml_hs_file = Nothing,
424 ml_hi_file = full_basename `joinFileExt` hisuf,
425 -- Remove the .hi-boot suffix from
426 -- hi_file, if it had one. We always
427 -- want the name of the real .hi file
428 -- in the ml_hi_file field.
432 -- | Constructs the filename of a .o file for a given source file.
433 -- Does /not/ check whether the .o file exists
436 -> FilePath -- the filename of the source file, minus the extension
437 -> String -- the module name with dots replaced by slashes
439 mkObjPath dflags basename mod_basename
441 odir = objectDir dflags
442 osuf = objectSuf dflags
444 obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
445 | otherwise = basename
447 return (obj_basename `joinFileExt` osuf)
449 -- | Constructs the filename of a .hi file for a given source file.
450 -- Does /not/ check whether the .hi file exists
453 -> FilePath -- the filename of the source file, minus the extension
454 -> String -- the module name with dots replaced by slashes
456 mkHiPath dflags basename mod_basename
461 hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
462 | otherwise = basename
464 return (hi_basename `joinFileExt` hisuf)
467 -- -----------------------------------------------------------------------------
468 -- Filenames of the stub files
470 -- We don't have to store these in ModLocations, because they can be derived
471 -- from other available information, and they're only rarely needed.
477 -> (FilePath,FilePath,FilePath)
479 mkStubPaths dflags mod location
481 stubdir = stubDir dflags
483 mod_basename = moduleNameSlashes mod
484 src_basename = basenameOf (expectJust "mkStubPaths"
485 (ml_hs_file location))
488 | Just dir <- stubdir = dir `joinFileName` mod_basename
489 | otherwise = src_basename
491 stub_basename = stub_basename0 ++ "_stub"
493 -- this is the filename we're going to use when
494 -- #including the stub_h file from the .hc file.
495 -- Without -stubdir, we just #include the basename
496 -- (eg. for a module A.B, we #include "B_stub.h"),
497 -- relying on the fact that we add an implicit -I flag
498 -- for the directory in which the source file resides
499 -- (see DriverPipeline.hs). With -stubdir, we
500 -- #include "A/B.h", assuming that the user has added
501 -- -I<dir> along with -stubdir <dir>.
503 | Just _ <- stubdir = mod_basename
504 | otherwise = filenameOf src_basename
506 (stub_basename `joinFileExt` "c",
507 stub_basename `joinFileExt` "h",
508 (include_basename ++ "_stub") `joinFileExt` "h")
509 -- the _stub.o filename is derived from the ml_obj_file.
511 -- -----------------------------------------------------------------------------
512 -- findLinkable isn't related to the other stuff in here,
513 -- but there's no other obvious place for it
515 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
516 findObjectLinkableMaybe mod locn
517 = do let obj_fn = ml_obj_file locn
518 maybe_obj_time <- modificationTimeIfExists obj_fn
519 case maybe_obj_time of
520 Nothing -> return Nothing
521 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
523 -- Make an object linkable when we know the object file exists, and we know
524 -- its modification time.
525 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
526 findObjectLinkable mod obj_fn obj_time = do
527 let stub_fn = case splitFilename3 obj_fn of
528 (dir, base, _ext) -> dir ++ "/" ++ base ++ "_stub.o"
529 stub_exist <- doesFileExist stub_fn
531 then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
532 else return (LM obj_time mod [DotO obj_fn])
534 -- -----------------------------------------------------------------------------
537 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
538 cannotFindModule = cantFindErr SLIT("Could not find module")
540 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
541 cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
543 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
544 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
545 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
546 sep [ptext SLIT("it was found in multiple packages:"),
547 hsep (map (text.packageIdString) pkgs)]
549 cantFindErr cannot_find dflags mod_name find_result
550 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
554 = case find_result of
556 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
557 <+> ptext SLIT("which is hidden")
560 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
564 -> ptext SLIT("no package matching") <+> ppr pkg <+>
565 ptext SLIT("was found")
567 NotFound files mb_pkg
569 -> ptext SLIT("it is not a module in the current program, or in any known package.")
570 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
572 build = if build_tag == "p" then "profiling"
573 else "\"" ++ build_tag ++ "\""
575 ptext SLIT("Perhaps you haven't installed the ") <> text build <>
576 ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
582 NotFoundInPackage pkg
583 -> ptext SLIT("it is not in package") <+> ppr pkg
585 _ -> panic "cantFindErr"
587 build_tag = buildTag dflags
590 | verbosity dflags < 3
591 = ptext SLIT("Use -v to see a list of the files searched for.")
593 = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))