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
45 import System.FilePath
48 import System.Time ( ClockTime )
51 type FileExt = String -- Filename extension
52 type BaseName = String -- Basename of file
54 -- -----------------------------------------------------------------------------
57 -- The Finder provides a thin filesystem abstraction to the rest of
58 -- the compiler. For a given module, it can tell you where the
59 -- source, interface, and object files for that module live.
61 -- It does *not* know which particular package a module lives in. Use
62 -- Packages.lookupModuleInAllPackages for that.
64 -- -----------------------------------------------------------------------------
67 -- remove all the home modules from the cache; package modules are
68 -- assumed to not move around during a session.
69 flushFinderCaches :: HscEnv -> IO ()
70 flushFinderCaches hsc_env = do
71 writeIORef fc_ref emptyUFM
72 flushModLocationCache this_pkg mlc_ref
74 this_pkg = thisPackage (hsc_dflags hsc_env)
75 fc_ref = hsc_FC hsc_env
76 mlc_ref = hsc_MLC hsc_env
78 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
79 flushModLocationCache this_pkg ref = do
81 writeIORef ref $! filterFM is_ext fm
83 where is_ext mod _ | modulePackageId mod /= this_pkg = True
86 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
87 addToFinderCache ref key val = modifyIORef ref $ \c -> addToUFM c key val
89 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
90 addToModLocationCache ref key val = modifyIORef ref $ \c -> addToFM c key val
92 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
93 removeFromFinderCache ref key = modifyIORef ref $ \c -> delFromUFM c key
95 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
96 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
98 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
99 lookupFinderCache ref key = do
101 return $! lookupUFM c key
103 lookupModLocationCache :: IORef ModLocationCache -> Module
104 -> IO (Maybe ModLocation)
105 lookupModLocationCache ref key = do
107 return $! lookupFM c key
109 -- -----------------------------------------------------------------------------
110 -- The two external entry points
112 -- | Locate a module that was imported by the user. We have the
113 -- module's name, and possibly a package name. Without a package
114 -- name, this function will use the search path and the known exposed
115 -- packages to find the module, if a package is specified then only
116 -- that package is searched for the module.
118 findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
119 findImportedModule hsc_env mod_name mb_pkgid =
121 Nothing -> unqual_import
122 Just pkg | pkg == this_pkg -> home_import
123 | otherwise -> pkg_import pkg
125 dflags = hsc_dflags hsc_env
126 this_pkg = thisPackage dflags
128 home_import = findHomeModule hsc_env mod_name
130 pkg_import pkg = findPackageModule hsc_env (mkModule pkg mod_name)
131 -- ToDo: this isn't quite right, the module we want
132 -- might actually be in another package, but re-exposed
133 -- ToDo: should return NotFoundInPackage if
134 -- the module isn't exposed by the package.
136 unqual_import = home_import
138 findExposedPackageModule hsc_env mod_name
140 -- | Locate a specific 'Module'. The purpose of this function is to
141 -- create a 'ModLocation' for a given 'Module', that is to find out
142 -- where the files associated with this module live. It is used when
143 -- reading the interface for a module mentioned by another interface,
144 -- for example (a "system import").
146 findExactModule :: HscEnv -> Module -> IO FindResult
147 findExactModule hsc_env mod =
148 let dflags = hsc_dflags hsc_env in
149 if modulePackageId mod == thisPackage dflags
150 then findHomeModule hsc_env (moduleName mod)
151 else findPackageModule hsc_env mod
153 -- -----------------------------------------------------------------------------
156 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
157 this `orIfNotFound` or_this = do
160 NotFound here _ -> do
163 NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
164 _other -> return res2
168 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
169 homeSearchCache hsc_env mod_name do_this = do
170 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
172 Just result -> return result
175 addToFinderCache (hsc_FC hsc_env) mod_name result
177 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
181 findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
182 findExposedPackageModule hsc_env mod_name
183 -- not found in any package:
184 | null found = return (NotFound [] Nothing)
185 -- found in just one exposed package:
186 | [(pkg_conf, _)] <- found_exposed
187 = let pkgid = mkPackageId (package pkg_conf) in
188 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
189 -- not found in any exposed package, report how it was hidden:
190 | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
191 = let pkgid = mkPackageId (package pkg_conf) in
193 then return (ModuleHidden pkgid)
194 else return (PackageHidden pkgid)
196 = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
198 dflags = hsc_dflags hsc_env
199 found = lookupModuleInAllPackages dflags mod_name
200 found_exposed = filter is_exposed found
201 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
204 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
205 modLocationCache hsc_env mod do_this = do
206 mb_loc <- lookupModLocationCache mlc mod
208 Just loc -> return (Found loc mod)
212 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
216 mlc = hsc_MLC hsc_env
218 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
219 addHomeModuleToFinder hsc_env mod_name loc = do
220 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
221 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
222 addToModLocationCache (hsc_MLC hsc_env) mod loc
225 uncacheModule :: HscEnv -> ModuleName -> IO ()
226 uncacheModule hsc_env mod = do
227 let this_pkg = thisPackage (hsc_dflags hsc_env)
228 removeFromFinderCache (hsc_FC hsc_env) mod
229 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
231 -- -----------------------------------------------------------------------------
232 -- The internal workers
234 -- | Search for a module in the home package only.
235 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
236 findHomeModule hsc_env mod_name =
237 homeSearchCache hsc_env mod_name $
239 dflags = hsc_dflags hsc_env
240 home_path = importPaths dflags
242 mod = mkModule (thisPackage dflags) mod_name
245 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
246 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
249 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
250 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
253 -- In compilation manager modes, we look for source files in the home
254 -- package because we can compile these automatically. In one-shot
255 -- compilation mode we look for .hi and .hi-boot files only.
256 exts | isOneShot (ghcMode dflags) = hi_exts
257 | otherwise = source_exts
260 -- special case for GHC.Prim; we won't find it in the filesystem.
261 -- This is important only when compiling the base package (where GHC.Prim
262 -- is a home module).
264 then return (Found (error "GHC.Prim ModLocation") mod)
267 searchPathExts home_path mod exts
270 -- | Search for a module in external packages only.
271 findPackageModule :: HscEnv -> Module -> IO FindResult
272 findPackageModule hsc_env mod = do
274 dflags = hsc_dflags hsc_env
275 pkg_id = modulePackageId mod
276 pkg_map = pkgIdMap (pkgState dflags)
278 case lookupPackage pkg_map pkg_id of
279 Nothing -> return (NoPackage pkg_id)
280 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
282 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
283 findPackageModule_ hsc_env mod pkg_conf =
284 modLocationCache hsc_env mod $
286 -- special case for GHC.Prim; we won't find it in the filesystem.
288 then return (Found (error "GHC.Prim ModLocation") mod)
292 dflags = hsc_dflags hsc_env
293 tag = buildTag dflags
295 -- hi-suffix for packages depends on the build tag.
296 package_hisuf | null tag = "hi"
297 | otherwise = tag ++ "_hi"
299 [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
302 [ ("hs", mkHiOnlyModLocation dflags package_hisuf)
303 , ("lhs", mkHiOnlyModLocation dflags package_hisuf)
306 -- mkdependHS needs to look for source files in packages too, so
307 -- that we can make dependencies between package before they have
310 | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
311 | otherwise = hi_exts
312 -- we never look for a .hi-boot file in an external package;
313 -- .hi-boot files only make sense for the home package.
315 searchPathExts (importDirs pkg_conf) mod exts
317 -- -----------------------------------------------------------------------------
318 -- General path searching
321 :: [FilePath] -- paths to search
322 -> Module -- module name
325 FilePath -> BaseName -> IO ModLocation -- action
330 searchPathExts paths mod exts
331 = do result <- search to_search
333 hPutStrLn stderr (showSDoc $
334 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
335 , nest 2 (vcat (map text paths))
337 Succeeded (loc, p) -> text "Found" <+> ppr loc
338 Failed fs -> text "not found"])
343 basename = moduleNameSlashes (moduleName mod)
345 to_search :: [(FilePath, IO ModLocation)]
346 to_search = [ (file, fn path basename)
349 let base | path == "." = basename
350 | otherwise = path </> basename
354 search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
355 search ((file, mk_result) : rest) = do
356 b <- doesFileExist file
358 then do { loc <- mk_result; return (Found loc mod) }
361 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
362 -> FilePath -> BaseName -> IO ModLocation
363 mkHomeModLocationSearched dflags mod suff path basename = do
364 mkHomeModLocation2 dflags mod (path </> basename) suff
366 -- -----------------------------------------------------------------------------
367 -- Constructing a home module location
369 -- This is where we construct the ModLocation for a module in the home
370 -- package, for which we have a source file. It is called from three
373 -- (a) Here in the finder, when we are searching for a module to import,
374 -- using the search path (-i option).
376 -- (b) The compilation manager, when constructing the ModLocation for
377 -- a "root" module (a source file named explicitly on the command line
378 -- or in a :load command in GHCi).
380 -- (c) The driver in one-shot mode, when we need to construct a
381 -- ModLocation for a source file named on the command-line.
386 -- The name of the module
389 -- (a): The search path component where the source file was found.
393 -- (a): (moduleNameSlashes mod)
394 -- (b) and (c): The filename of the source file, minus its extension
397 -- The filename extension of the source file (usually "hs" or "lhs").
399 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
400 mkHomeModLocation dflags mod src_filename = do
401 let (basename,extension) = splitExtension src_filename
402 mkHomeModLocation2 dflags mod basename extension
404 mkHomeModLocation2 :: DynFlags
406 -> FilePath -- Of source module, without suffix
409 mkHomeModLocation2 dflags mod src_basename ext = do
410 let mod_basename = moduleNameSlashes mod
412 obj_fn <- mkObjPath dflags src_basename mod_basename
413 hi_fn <- mkHiPath dflags src_basename mod_basename
415 return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
417 ml_obj_file = obj_fn })
419 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
421 mkHiOnlyModLocation dflags hisuf path basename
422 = do let full_basename = path </> basename
423 obj_fn <- mkObjPath dflags full_basename basename
424 return ModLocation{ ml_hs_file = Nothing,
425 ml_hi_file = full_basename <.> hisuf,
426 -- Remove the .hi-boot suffix from
427 -- hi_file, if it had one. We always
428 -- want the name of the real .hi file
429 -- in the ml_hi_file field.
433 -- | Constructs the filename of a .o file for a given source file.
434 -- Does /not/ check whether the .o file exists
437 -> FilePath -- the filename of the source file, minus the extension
438 -> String -- the module name with dots replaced by slashes
440 mkObjPath dflags basename mod_basename
442 odir = objectDir dflags
443 osuf = objectSuf dflags
445 obj_basename | Just dir <- odir = dir </> mod_basename
446 | otherwise = basename
448 return (obj_basename <.> osuf)
450 -- | Constructs the filename of a .hi file for a given source file.
451 -- Does /not/ check whether the .hi file exists
454 -> FilePath -- the filename of the source file, minus the extension
455 -> String -- the module name with dots replaced by slashes
457 mkHiPath dflags basename mod_basename
462 hi_basename | Just dir <- hidir = dir </> mod_basename
463 | otherwise = basename
465 return (hi_basename <.> hisuf)
468 -- -----------------------------------------------------------------------------
469 -- Filenames of the stub files
471 -- We don't have to store these in ModLocations, because they can be derived
472 -- from other available information, and they're only rarely needed.
478 -> (FilePath,FilePath,FilePath)
480 mkStubPaths dflags mod location
482 stubdir = stubDir dflags
484 mod_basename = dots_to_slashes (moduleNameString mod)
485 src_basename = dropExtension $ expectJust "mkStubPaths"
486 (ml_hs_file location)
489 | Just dir <- stubdir = dir </> mod_basename
490 | otherwise = src_basename
492 stub_basename = stub_basename0 ++ "_stub"
494 -- this is the filename we're going to use when
495 -- #including the stub_h file from the .hc file.
496 -- Without -stubdir, we just #include the basename
497 -- (eg. for a module A.B, we #include "B_stub.h"),
498 -- relying on the fact that we add an implicit -I flag
499 -- for the directory in which the source file resides
500 -- (see DriverPipeline.hs). With -stubdir, we
501 -- #include "A/B.h", assuming that the user has added
502 -- -I<dir> along with -stubdir <dir>.
504 | Just _ <- stubdir = mod_basename
505 | otherwise = takeFileName src_basename
507 (stub_basename <.> "c",
508 stub_basename <.> "h",
509 (include_basename ++ "_stub") <.> "h")
510 -- the _stub.o filename is derived from the ml_obj_file.
512 -- -----------------------------------------------------------------------------
513 -- findLinkable isn't related to the other stuff in here,
514 -- but there's no other obvious place for it
516 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
517 findObjectLinkableMaybe mod locn
518 = do let obj_fn = ml_obj_file locn
519 maybe_obj_time <- modificationTimeIfExists obj_fn
520 case maybe_obj_time of
521 Nothing -> return Nothing
522 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
524 -- Make an object linkable when we know the object file exists, and we know
525 -- its modification time.
526 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
527 findObjectLinkable mod obj_fn obj_time = do
528 let stub_fn = (dropExtension obj_fn ++ "_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 dots_to_slashes :: String -> String
538 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
540 -- -----------------------------------------------------------------------------
543 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
544 cannotFindModule = cantFindErr SLIT("Could not find module")
546 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
547 cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
549 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
550 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
551 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
552 sep [ptext SLIT("it was found in multiple packages:"),
553 hsep (map (text.packageIdString) pkgs)]
555 cantFindErr cannot_find dflags mod_name find_result
556 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
560 = case find_result of
562 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
563 <+> ptext SLIT("which is hidden")
566 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
570 -> ptext SLIT("no package matching") <+> ppr pkg <+>
571 ptext SLIT("was found")
573 NotFound files mb_pkg
575 -> ptext SLIT("it is not a module in the current program, or in any known package.")
576 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
578 build = if build_tag == "p" then "profiling"
579 else "\"" ++ build_tag ++ "\""
581 ptext SLIT("Perhaps you haven't installed the ") <> text build <>
582 ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
588 NotFoundInPackage pkg
589 -> ptext SLIT("it is not in package") <+> ppr pkg
591 _ -> panic "cantFindErr"
593 build_tag = buildTag dflags
596 | verbosity dflags < 3
597 = ptext SLIT("Use -v to see a list of the files searched for.")
599 = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))