2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
16 addHomeModuleToFinder,
20 findObjectLinkableMaybe,
33 import PrelNames ( gHC_PRIM )
34 import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) )
38 import Maybes ( expectJust )
40 import Distribution.Package hiding (PackageId)
41 import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
43 import System.Directory
44 import System.FilePath
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 FastString -> IO FindResult
118 findImportedModule hsc_env mod_name mb_pkg =
120 Nothing -> unqual_import
121 Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
122 | otherwise -> pkg_import
124 home_import = findHomeModule hsc_env mod_name
126 pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
128 unqual_import = home_import
130 findExposedPackageModule hsc_env mod_name Nothing
132 -- | Locate a specific 'Module'. The purpose of this function is to
133 -- create a 'ModLocation' for a given 'Module', that is to find out
134 -- where the files associated with this module live. It is used when
135 -- reading the interface for a module mentioned by another interface,
136 -- for example (a "system import").
138 findExactModule :: HscEnv -> Module -> IO FindResult
139 findExactModule hsc_env mod =
140 let dflags = hsc_dflags hsc_env in
141 if modulePackageId mod == thisPackage dflags
142 then findHomeModule hsc_env (moduleName mod)
143 else findPackageModule hsc_env mod
145 -- -----------------------------------------------------------------------------
148 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
149 this `orIfNotFound` or_this = do
152 NotFound here _ -> do
155 NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
156 _other -> return res2
160 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
161 homeSearchCache hsc_env mod_name do_this = do
162 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
164 Just result -> return result
167 addToFinderCache (hsc_FC hsc_env) mod_name result
169 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
173 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
175 findExposedPackageModule hsc_env mod_name mb_pkg
176 -- not found in any package:
177 | null found = return (NotFound [] Nothing)
178 -- found in just one exposed package:
179 | [(pkg_conf, _)] <- found_exposed
180 = let pkgid = mkPackageId (package pkg_conf) in
181 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
182 -- not found in any exposed package, report how it was hidden:
183 | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
184 = let pkgid = mkPackageId (package pkg_conf) in
186 then return (ModuleHidden pkgid)
187 else return (PackageHidden pkgid)
189 = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
191 dflags = hsc_dflags hsc_env
192 found = lookupModuleInAllPackages dflags mod_name
194 found_exposed = [ (pkg_conf,exposed_mod)
195 | x@(pkg_conf,exposed_mod) <- found,
197 pkg_conf `matches` mb_pkg ]
199 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
201 _pkg_conf `matches` Nothing = True
202 pkg_conf `matches` Just pkg =
203 case packageName pkg_conf of
204 PackageName n -> pkg == mkFastString n
207 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
208 modLocationCache hsc_env mod do_this = do
209 mb_loc <- lookupModLocationCache mlc mod
211 Just loc -> return (Found loc mod)
215 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
219 mlc = hsc_MLC hsc_env
221 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
222 addHomeModuleToFinder hsc_env mod_name loc = do
223 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
224 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
225 addToModLocationCache (hsc_MLC hsc_env) mod loc
228 uncacheModule :: HscEnv -> ModuleName -> IO ()
229 uncacheModule hsc_env mod = do
230 let this_pkg = thisPackage (hsc_dflags hsc_env)
231 removeFromFinderCache (hsc_FC hsc_env) mod
232 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
234 -- -----------------------------------------------------------------------------
235 -- The internal workers
237 -- | Search for a module in the home package only.
238 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
239 findHomeModule hsc_env mod_name =
240 homeSearchCache hsc_env mod_name $
242 dflags = hsc_dflags hsc_env
243 home_path = importPaths dflags
245 mod = mkModule (thisPackage dflags) mod_name
248 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
249 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
252 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
253 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
256 -- In compilation manager modes, we look for source files in the home
257 -- package because we can compile these automatically. In one-shot
258 -- compilation mode we look for .hi and .hi-boot files only.
259 exts | isOneShot (ghcMode dflags) = hi_exts
260 | otherwise = source_exts
263 -- special case for GHC.Prim; we won't find it in the filesystem.
264 -- This is important only when compiling the base package (where GHC.Prim
265 -- is a home module).
267 then return (Found (error "GHC.Prim ModLocation") mod)
270 searchPathExts home_path mod exts
273 -- | Search for a module in external packages only.
274 findPackageModule :: HscEnv -> Module -> IO FindResult
275 findPackageModule hsc_env mod = do
277 dflags = hsc_dflags hsc_env
278 pkg_id = modulePackageId mod
279 pkg_map = pkgIdMap (pkgState dflags)
281 case lookupPackage pkg_map pkg_id of
282 Nothing -> return (NoPackage pkg_id)
283 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
285 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
286 findPackageModule_ hsc_env mod pkg_conf =
287 modLocationCache hsc_env mod $
289 -- special case for GHC.Prim; we won't find it in the filesystem.
291 then return (Found (error "GHC.Prim ModLocation") mod)
295 dflags = hsc_dflags hsc_env
296 tag = buildTag dflags
298 -- hi-suffix for packages depends on the build tag.
299 package_hisuf | null tag = "hi"
300 | otherwise = tag ++ "_hi"
302 [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
305 [ ("hs", mkHiOnlyModLocation dflags package_hisuf)
306 , ("lhs", mkHiOnlyModLocation dflags package_hisuf)
309 -- mkdependHS needs to look for source files in packages too, so
310 -- that we can make dependencies between package before they have
313 | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
314 | otherwise = hi_exts
315 -- we never look for a .hi-boot file in an external package;
316 -- .hi-boot files only make sense for the home package.
318 searchPathExts (importDirs pkg_conf) mod exts
320 -- -----------------------------------------------------------------------------
321 -- General path searching
324 :: [FilePath] -- paths to search
325 -> Module -- module name
328 FilePath -> BaseName -> IO ModLocation -- action
333 searchPathExts paths mod exts
334 = do result <- search to_search
336 hPutStrLn stderr (showSDoc $
337 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
338 , nest 2 (vcat (map text paths))
340 Succeeded (loc, p) -> text "Found" <+> ppr loc
341 Failed fs -> text "not found"])
346 basename = moduleNameSlashes (moduleName mod)
348 to_search :: [(FilePath, IO ModLocation)]
349 to_search = [ (file, fn path basename)
352 let base | path == "." = basename
353 | otherwise = path </> basename
357 search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
358 search ((file, mk_result) : rest) = do
359 b <- doesFileExist file
361 then do { loc <- mk_result; return (Found loc mod) }
364 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
365 -> FilePath -> BaseName -> IO ModLocation
366 mkHomeModLocationSearched dflags mod suff path basename = do
367 mkHomeModLocation2 dflags mod (path </> basename) suff
369 -- -----------------------------------------------------------------------------
370 -- Constructing a home module location
372 -- This is where we construct the ModLocation for a module in the home
373 -- package, for which we have a source file. It is called from three
376 -- (a) Here in the finder, when we are searching for a module to import,
377 -- using the search path (-i option).
379 -- (b) The compilation manager, when constructing the ModLocation for
380 -- a "root" module (a source file named explicitly on the command line
381 -- or in a :load command in GHCi).
383 -- (c) The driver in one-shot mode, when we need to construct a
384 -- ModLocation for a source file named on the command-line.
389 -- The name of the module
392 -- (a): The search path component where the source file was found.
396 -- (a): (moduleNameSlashes mod)
397 -- (b) and (c): The filename of the source file, minus its extension
400 -- The filename extension of the source file (usually "hs" or "lhs").
402 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
403 mkHomeModLocation dflags mod src_filename = do
404 let (basename,extension) = splitExtension src_filename
405 mkHomeModLocation2 dflags mod basename extension
407 mkHomeModLocation2 :: DynFlags
409 -> FilePath -- Of source module, without suffix
412 mkHomeModLocation2 dflags mod src_basename ext = do
413 let mod_basename = moduleNameSlashes mod
415 obj_fn <- mkObjPath dflags src_basename mod_basename
416 hi_fn <- mkHiPath dflags src_basename mod_basename
418 return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
420 ml_obj_file = obj_fn })
422 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
424 mkHiOnlyModLocation dflags hisuf path basename
425 = do let full_basename = path </> basename
426 obj_fn <- mkObjPath dflags full_basename basename
427 return ModLocation{ ml_hs_file = Nothing,
428 ml_hi_file = full_basename <.> hisuf,
429 -- Remove the .hi-boot suffix from
430 -- hi_file, if it had one. We always
431 -- want the name of the real .hi file
432 -- in the ml_hi_file field.
436 -- | Constructs the filename of a .o file for a given source file.
437 -- Does /not/ check whether the .o file exists
440 -> FilePath -- the filename of the source file, minus the extension
441 -> String -- the module name with dots replaced by slashes
443 mkObjPath dflags basename mod_basename
445 odir = objectDir dflags
446 osuf = objectSuf dflags
448 obj_basename | Just dir <- odir = dir </> mod_basename
449 | otherwise = basename
451 return (obj_basename <.> osuf)
453 -- | Constructs the filename of a .hi file for a given source file.
454 -- Does /not/ check whether the .hi file exists
457 -> FilePath -- the filename of the source file, minus the extension
458 -> String -- the module name with dots replaced by slashes
460 mkHiPath dflags basename mod_basename
465 hi_basename | Just dir <- hidir = dir </> mod_basename
466 | otherwise = basename
468 return (hi_basename <.> hisuf)
471 -- -----------------------------------------------------------------------------
472 -- Filenames of the stub files
474 -- We don't have to store these in ModLocations, because they can be derived
475 -- from other available information, and they're only rarely needed.
481 -> (FilePath,FilePath,FilePath)
483 mkStubPaths dflags mod location
485 stubdir = stubDir dflags
487 mod_basename = moduleNameSlashes mod
488 src_basename = dropExtension $ expectJust "mkStubPaths"
489 (ml_hs_file location)
492 | Just dir <- stubdir = dir </> mod_basename
493 | otherwise = src_basename
495 stub_basename = stub_basename0 ++ "_stub"
497 -- this is the filename we're going to use when
498 -- \#including the stub_h file from the .hc file.
499 -- Without -stubdir, we just #include the basename
500 -- (eg. for a module A.B, we #include "B_stub.h"),
501 -- relying on the fact that we add an implicit -I flag
502 -- for the directory in which the source file resides
503 -- (see DriverPipeline.hs). With -stubdir, we
504 -- \#include "A/B.h", assuming that the user has added
505 -- -I<dir> along with -stubdir <dir>.
507 | Just _ <- stubdir = mod_basename
508 | otherwise = takeFileName src_basename
510 (stub_basename <.> "c",
511 stub_basename <.> "h",
512 (include_basename ++ "_stub") <.> "h")
513 -- the _stub.o filename is derived from the ml_obj_file.
515 -- -----------------------------------------------------------------------------
516 -- findLinkable isn't related to the other stuff in here,
517 -- but there's no other obvious place for it
519 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
520 findObjectLinkableMaybe mod locn
521 = do let obj_fn = ml_obj_file locn
522 maybe_obj_time <- modificationTimeIfExists obj_fn
523 case maybe_obj_time of
524 Nothing -> return Nothing
525 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
527 -- Make an object linkable when we know the object file exists, and we know
528 -- its modification time.
529 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
530 findObjectLinkable mod obj_fn obj_time = do
531 let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"
532 stub_exist <- doesFileExist stub_fn
534 then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
535 else return (LM obj_time mod [DotO obj_fn])
537 -- -----------------------------------------------------------------------------
540 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
541 cannotFindModule = cantFindErr (sLit "Could not find module")
543 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
544 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
546 cantFindErr :: LitString -> DynFlags -> ModuleName -> FindResult -> SDoc
547 cantFindErr cannot_find _dflags mod_name (FoundMultiple pkgs)
548 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
549 sep [ptext (sLit "it was found in multiple packages:"),
550 hsep (map (text.packageIdString) pkgs)]
552 cantFindErr cannot_find dflags mod_name find_result
553 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
557 = case find_result of
559 -> ptext (sLit "it is a member of package") <+> ppr pkg <> comma
560 <+> ptext (sLit "which is hidden")
563 -> ptext (sLit "it is hidden") <+> parens (ptext (sLit "in package")
567 -> ptext (sLit "no package matching") <+> ppr pkg <+>
568 ptext (sLit "was found")
570 NotFound files mb_pkg
572 -> ptext (sLit "it is not a module in the current program, or in any known package.")
573 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
575 build = if build_tag == "p" then "profiling"
576 else "\"" ++ build_tag ++ "\""
578 ptext (sLit "Perhaps you haven't installed the ") <> text build <>
579 ptext (sLit " libraries for package ") <> ppr pkg <> char '?' $$
585 NotFoundInPackage pkg
586 -> ptext (sLit "it is not in package") <+> ppr pkg
588 _ -> panic "cantFindErr"
590 build_tag = buildTag dflags
593 | verbosity dflags < 3
594 = ptext (sLit "Use -v to see a list of the files searched for.")
596 = hang (ptext (sLit "locations searched:")) 2 (vcat (map text files))