2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
15 addHomeModuleToFinder,
19 findObjectLinkableMaybe,
26 #include "HsVersions.h"
33 import PrelNames ( gHC_PRIM )
34 import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) )
38 import Maybes ( expectJust )
40 import DATA_IOREF ( IORef, writeIORef, readIORef, modifyIORef )
43 import System.Directory
46 import Time ( ClockTime )
49 type FileExt = String -- Filename extension
50 type BaseName = String -- Basename of file
52 -- -----------------------------------------------------------------------------
55 -- The Finder provides a thin filesystem abstraction to the rest of
56 -- the compiler. For a given module, it can tell you where the
57 -- source, interface, and object files for that module live.
59 -- It does *not* know which particular package a module lives in. Use
60 -- Packages.lookupModuleInAllPackages for that.
62 -- -----------------------------------------------------------------------------
65 -- remove all the home modules from the cache; package modules are
66 -- assumed to not move around during a session.
67 flushFinderCaches :: HscEnv -> IO ()
68 flushFinderCaches hsc_env = do
69 writeIORef fc_ref emptyUFM
70 flushModLocationCache this_pkg mlc_ref
72 this_pkg = thisPackage (hsc_dflags hsc_env)
73 fc_ref = hsc_FC hsc_env
74 mlc_ref = hsc_MLC hsc_env
76 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
77 flushModLocationCache this_pkg ref = do
79 writeIORef ref $! filterFM is_ext fm
81 where is_ext mod _ | modulePackageId mod /= this_pkg = True
84 addToFinderCache ref key val = modifyIORef ref $ \c -> addToUFM c key val
85 addToModLocationCache ref key val = modifyIORef ref $ \c -> addToFM c key val
87 removeFromFinderCache ref key = modifyIORef ref $ \c -> delFromUFM c key
88 removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
90 lookupFinderCache ref key = do
92 return $! lookupUFM c key
94 lookupModLocationCache ref key = do
96 return $! lookupFM c key
98 -- -----------------------------------------------------------------------------
99 -- The two external entry points
101 -- | Locate a module that was imported by the user. We have the
102 -- module's name, and possibly a package name. Without a package
103 -- name, this function will use the search path and the known exposed
104 -- packages to find the module, if a package is specified then only
105 -- that package is searched for the module.
107 findImportedModule :: HscEnv -> ModuleName -> Maybe PackageId -> IO FindResult
108 findImportedModule hsc_env mod_name mb_pkgid =
110 Nothing -> unqual_import
111 Just pkg | pkg == this_pkg -> home_import
112 | otherwise -> pkg_import pkg
114 dflags = hsc_dflags hsc_env
115 this_pkg = thisPackage dflags
117 home_import = findHomeModule hsc_env mod_name
119 pkg_import pkg = findPackageModule hsc_env (mkModule pkg mod_name)
120 -- ToDo: this isn't quite right, the module we want
121 -- might actually be in another package, but re-exposed
122 -- ToDo: should return NotFoundInPackage if
123 -- the module isn't exposed by the package.
125 unqual_import = home_import
127 findExposedPackageModule hsc_env mod_name
129 -- | Locate a specific 'Module'. The purpose of this function is to
130 -- create a 'ModLocation' for a given 'Module', that is to find out
131 -- where the files associated with this module live. It is used when
132 -- reading the interface for a module mentioned by another interface,
133 -- for example (a "system import").
135 findExactModule :: HscEnv -> Module -> IO FindResult
136 findExactModule hsc_env mod =
137 let dflags = hsc_dflags hsc_env in
138 if modulePackageId mod == thisPackage dflags
139 then findHomeModule hsc_env (moduleName mod)
140 else findPackageModule hsc_env mod
142 -- -----------------------------------------------------------------------------
145 this `orIfNotFound` or_this = do
148 NotFound here _ -> do
151 NotFound or_here pkg -> return (NotFound (here ++ or_here) pkg)
152 _other -> return res2
156 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
157 homeSearchCache hsc_env mod_name do_this = do
158 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
160 Just result -> return result
163 addToFinderCache (hsc_FC hsc_env) mod_name result
165 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
169 findExposedPackageModule :: HscEnv -> ModuleName -> IO FindResult
170 findExposedPackageModule hsc_env mod_name
171 -- not found in any package:
172 | null found = return (NotFound [] Nothing)
173 -- found in just one exposed package:
174 | [(pkg_conf, _)] <- found_exposed
175 = let pkgid = mkPackageId (package pkg_conf) in
176 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
177 -- not found in any exposed package, report how it was hidden:
178 | null found_exposed, ((pkg_conf, exposed_mod):_) <- found
179 = let pkgid = mkPackageId (package pkg_conf) in
181 then return (ModuleHidden pkgid)
182 else return (PackageHidden pkgid)
184 = return (FoundMultiple (map (mkPackageId.package.fst) found_exposed))
186 dflags = hsc_dflags hsc_env
187 found = lookupModuleInAllPackages dflags mod_name
188 found_exposed = filter is_exposed found
189 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
192 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
193 modLocationCache hsc_env mod do_this = do
194 mb_loc <- lookupModLocationCache mlc mod
196 Just loc -> return (Found loc mod)
200 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
204 mlc = hsc_MLC hsc_env
206 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
207 addHomeModuleToFinder hsc_env mod_name loc = do
208 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
209 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
210 addToModLocationCache (hsc_MLC hsc_env) mod loc
213 uncacheModule :: HscEnv -> ModuleName -> IO ()
214 uncacheModule hsc_env mod = do
215 let this_pkg = thisPackage (hsc_dflags hsc_env)
216 removeFromFinderCache (hsc_FC hsc_env) mod
217 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
219 -- -----------------------------------------------------------------------------
220 -- The internal workers
222 -- | Search for a module in the home package only.
223 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
224 findHomeModule hsc_env mod_name =
225 homeSearchCache hsc_env mod_name $
227 dflags = hsc_dflags hsc_env
228 home_path = importPaths dflags
230 mod = mkModule (thisPackage dflags) mod_name
233 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
234 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
237 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
238 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
241 -- In compilation manager modes, we look for source files in the home
242 -- package because we can compile these automatically. In one-shot
243 -- compilation mode we look for .hi and .hi-boot files only.
244 exts | isOneShot (ghcMode dflags) = hi_exts
245 | otherwise = source_exts
247 searchPathExts home_path mod exts
250 -- | Search for a module in external packages only.
251 findPackageModule :: HscEnv -> Module -> IO FindResult
252 findPackageModule hsc_env mod = do
254 dflags = hsc_dflags hsc_env
255 pkg_id = modulePackageId mod
256 pkg_map = pkgIdMap (pkgState dflags)
258 case lookupPackage pkg_map pkg_id of
259 Nothing -> return (NoPackage pkg_id)
260 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
262 findPackageModule_ hsc_env mod pkg_conf =
263 modLocationCache hsc_env mod $
265 -- special case for GHC.Prim; we won't find it in the filesystem.
267 then return (Found (error "GHC.Prim ModLocation") mod)
271 dflags = hsc_dflags hsc_env
272 tag = buildTag dflags
274 -- hi-suffix for packages depends on the build tag.
275 package_hisuf | null tag = "hi"
276 | otherwise = tag ++ "_hi"
278 [ (package_hisuf, mkHiOnlyModLocation dflags package_hisuf) ]
281 [ ("hs", mkHiOnlyModLocation dflags package_hisuf)
282 , ("lhs", mkHiOnlyModLocation dflags package_hisuf)
285 -- mkdependHS needs to look for source files in packages too, so
286 -- that we can make dependencies between package before they have
289 | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
290 | otherwise = hi_exts
291 -- we never look for a .hi-boot file in an external package;
292 -- .hi-boot files only make sense for the home package.
294 searchPathExts (importDirs pkg_conf) mod exts
296 -- -----------------------------------------------------------------------------
297 -- General path searching
300 :: [FilePath] -- paths to search
301 -> Module -- module name
304 FilePath -> BaseName -> IO ModLocation -- action
309 searchPathExts paths mod exts
310 = do result <- search to_search
312 hPutStrLn stderr (showSDoc $
313 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
314 , nest 2 (vcat (map text paths))
316 Succeeded (loc, p) -> text "Found" <+> ppr loc
317 Failed fs -> text "not found"])
322 basename = dots_to_slashes (moduleNameString (moduleName mod))
324 to_search :: [(FilePath, IO ModLocation)]
325 to_search = [ (file, fn path basename)
328 let base | path == "." = basename
329 | otherwise = path `joinFileName` basename
330 file = base `joinFileExt` ext
333 search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod)))
334 search ((file, mk_result) : rest) = do
335 b <- doesFileExist file
337 then do { loc <- mk_result; return (Found loc mod) }
340 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
341 -> FilePath -> BaseName -> IO ModLocation
342 mkHomeModLocationSearched dflags mod suff path basename = do
343 mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
345 -- -----------------------------------------------------------------------------
346 -- Constructing a home module location
348 -- This is where we construct the ModLocation for a module in the home
349 -- package, for which we have a source file. It is called from three
352 -- (a) Here in the finder, when we are searching for a module to import,
353 -- using the search path (-i option).
355 -- (b) The compilation manager, when constructing the ModLocation for
356 -- a "root" module (a source file named explicitly on the command line
357 -- or in a :load command in GHCi).
359 -- (c) The driver in one-shot mode, when we need to construct a
360 -- ModLocation for a source file named on the command-line.
365 -- The name of the module
368 -- (a): The search path component where the source file was found.
372 -- (a): dots_to_slashes (moduleNameUserString mod)
373 -- (b) and (c): The filename of the source file, minus its extension
376 -- The filename extension of the source file (usually "hs" or "lhs").
378 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
379 mkHomeModLocation dflags mod src_filename = do
380 let (basename,extension) = splitFilename src_filename
381 mkHomeModLocation2 dflags mod basename extension
383 mkHomeModLocation2 :: DynFlags
385 -> FilePath -- Of source module, without suffix
388 mkHomeModLocation2 dflags mod src_basename ext = do
389 let mod_basename = dots_to_slashes (moduleNameString mod)
391 obj_fn <- mkObjPath dflags src_basename mod_basename
392 hi_fn <- mkHiPath dflags src_basename mod_basename
394 return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
396 ml_obj_file = obj_fn })
398 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
400 mkHiOnlyModLocation dflags hisuf path basename
401 = do let full_basename = path `joinFileName` basename
402 obj_fn <- mkObjPath dflags full_basename basename
403 return ModLocation{ ml_hs_file = Nothing,
404 ml_hi_file = full_basename `joinFileExt` hisuf,
405 -- Remove the .hi-boot suffix from
406 -- hi_file, if it had one. We always
407 -- want the name of the real .hi file
408 -- in the ml_hi_file field.
412 -- | Constructs the filename of a .o file for a given source file.
413 -- Does /not/ check whether the .o file exists
416 -> FilePath -- the filename of the source file, minus the extension
417 -> String -- the module name with dots replaced by slashes
419 mkObjPath dflags basename mod_basename
421 odir = objectDir dflags
422 osuf = objectSuf dflags
424 obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
425 | otherwise = basename
427 return (obj_basename `joinFileExt` osuf)
429 -- | Constructs the filename of a .hi file for a given source file.
430 -- Does /not/ check whether the .hi file exists
433 -> FilePath -- the filename of the source file, minus the extension
434 -> String -- the module name with dots replaced by slashes
436 mkHiPath dflags basename mod_basename
441 hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
442 | otherwise = basename
444 return (hi_basename `joinFileExt` hisuf)
447 -- -----------------------------------------------------------------------------
448 -- Filenames of the stub files
450 -- We don't have to store these in ModLocations, because they can be derived
451 -- from other available information, and they're only rarely needed.
457 -> (FilePath,FilePath)
459 mkStubPaths dflags mod location
461 stubdir = stubDir dflags
463 mod_basename = dots_to_slashes (moduleNameString mod)
464 src_basename = basenameOf (expectJust "mkStubPaths"
465 (ml_hs_file location))
468 | Just dir <- stubdir = dir `joinFileName` mod_basename
469 | otherwise = src_basename
471 stub_basename = stub_basename0 ++ "_stub"
473 (stub_basename `joinFileExt` "c",
474 stub_basename `joinFileExt` "h")
475 -- the _stub.o filename is derived from the ml_obj_file.
477 -- -----------------------------------------------------------------------------
478 -- findLinkable isn't related to the other stuff in here,
479 -- but there's no other obvious place for it
481 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
482 findObjectLinkableMaybe mod locn
483 = do let obj_fn = ml_obj_file locn
484 maybe_obj_time <- modificationTimeIfExists obj_fn
485 case maybe_obj_time of
486 Nothing -> return Nothing
487 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
489 -- Make an object linkable when we know the object file exists, and we know
490 -- its modification time.
491 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
492 findObjectLinkable mod obj_fn obj_time = do
493 let stub_fn = case splitFilename3 obj_fn of
494 (dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
495 stub_exist <- doesFileExist stub_fn
497 then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
498 else return (LM obj_time mod [DotO obj_fn])
500 -- -----------------------------------------------------------------------------
503 dots_to_slashes = map (\c -> if c == '.' then '/' else c)
506 -- -----------------------------------------------------------------------------
509 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
510 cannotFindModule = cantFindErr SLIT("Could not find module")
512 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
513 cannotFindInterface = cantFindErr SLIT("Failed to load interface for")
515 cantFindErr cannot_find dflags mod_name (FoundMultiple pkgs)
516 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon) 2 (
517 sep [ptext SLIT("it was found in multiple packages:"),
518 hsep (map (text.packageIdString) pkgs)]
520 cantFindErr cannot_find dflags mod_name find_result
521 = hang (ptext cannot_find <+> quotes (ppr mod_name) <> colon)
525 = case find_result of
527 -> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
528 <+> ptext SLIT("which is hidden")
531 -> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
535 -> ptext SLIT("no package matching") <+> ppr pkg <+>
536 ptext SLIT("was found")
538 NotFound files mb_pkg
540 -> ptext SLIT("it is not a module in the current program, or in any known package.")
541 | Just pkg <- mb_pkg, pkg /= thisPackage dflags, build_tag /= ""
543 build = if build_tag == "p" then "profiling"
544 else "\"" ++ build_tag ++ "\""
546 ptext SLIT("Perhaps you haven't installed the ") <> text build <>
547 ptext SLIT(" libraries for package ") <> ppr pkg <> char '?' $$
553 NotFoundInPackage pkg
554 -> ptext SLIT("it is not in package") <+> ppr pkg
556 _ -> panic "cantFindErr"
558 build_tag = buildTag dflags
561 | verbosity dflags < 3
562 = ptext SLIT("Use -v to see a list of the files searched for.")
564 = hang (ptext SLIT("locations searched:")) 2 (vcat (map text files))