2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
13 findExposedPackageModule,
17 addHomeModuleToFinder,
21 findObjectLinkableMaybe,
29 #include "HsVersions.h"
36 import PrelNames ( gHC_PRIM )
40 import Maybes ( expectJust )
41 import Exception ( evaluate )
43 import Distribution.Text
44 import Distribution.Package hiding (PackageId)
45 import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef )
46 import System.Directory
47 import System.FilePath
49 import System.Time ( ClockTime )
50 import Data.List ( partition )
53 type FileExt = String -- Filename extension
54 type BaseName = String -- Basename of file
56 -- -----------------------------------------------------------------------------
59 -- The Finder provides a thin filesystem abstraction to the rest of
60 -- the compiler. For a given module, it can tell you where the
61 -- source, interface, and object files for that module live.
63 -- It does *not* know which particular package a module lives in. Use
64 -- Packages.lookupModuleInAllPackages for that.
66 -- -----------------------------------------------------------------------------
69 -- remove all the home modules from the cache; package modules are
70 -- assumed to not move around during a session.
71 flushFinderCaches :: HscEnv -> IO ()
72 flushFinderCaches hsc_env = do
73 -- Ideally the update to both caches be a single atomic operation.
74 writeIORef fc_ref emptyUFM
75 flushModLocationCache this_pkg mlc_ref
77 this_pkg = thisPackage (hsc_dflags hsc_env)
78 fc_ref = hsc_FC hsc_env
79 mlc_ref = hsc_MLC hsc_env
81 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
82 flushModLocationCache this_pkg ref = do
83 atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
84 _ <- evaluate =<< readIORef ref
86 where is_ext mod _ | modulePackageId mod /= this_pkg = True
89 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
90 addToFinderCache ref key val =
91 atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
93 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
94 addToModLocationCache ref key val =
95 atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
97 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
98 removeFromFinderCache ref key =
99 atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
101 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
102 removeFromModLocationCache ref key =
103 atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
105 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
106 lookupFinderCache ref key = do
108 return $! lookupUFM c key
110 lookupModLocationCache :: IORef ModLocationCache -> Module
111 -> IO (Maybe ModLocation)
112 lookupModLocationCache ref key = do
114 return $! lookupModuleEnv c key
116 -- -----------------------------------------------------------------------------
117 -- The two external entry points
119 -- | Locate a module that was imported by the user. We have the
120 -- module's name, and possibly a package name. Without a package
121 -- name, this function will use the search path and the known exposed
122 -- packages to find the module, if a package is specified then only
123 -- that package is searched for the module.
125 findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
126 findImportedModule hsc_env mod_name mb_pkg =
128 Nothing -> unqual_import
129 Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
130 | otherwise -> pkg_import
132 home_import = findHomeModule hsc_env mod_name
134 pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
136 unqual_import = home_import
138 findExposedPackageModule hsc_env mod_name Nothing
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 orIfNotFound this or_this = do
160 NotFound { fr_paths = paths1, fr_mods_hidden = mh1
161 , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
162 -> do res2 <- or_this
164 NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
165 , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
166 -> return (NotFound { fr_paths = paths1 ++ paths2
167 , fr_pkg = mb_pkg2 -- snd arg is the package search
168 , fr_mods_hidden = mh1 ++ mh2
169 , fr_pkgs_hidden = ph1 ++ ph2
170 , fr_suggestions = s1 ++ s2 })
171 _other -> return res2
175 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
176 homeSearchCache hsc_env mod_name do_this = do
177 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
179 Just result -> return result
182 addToFinderCache (hsc_FC hsc_env) mod_name result
184 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
188 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
190 findExposedPackageModule hsc_env mod_name mb_pkg
191 -- not found in any package:
192 = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of
193 Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing
194 , fr_pkgs_hidden = [], fr_mods_hidden = []
195 , fr_suggestions = suggest })
197 | null found_exposed -- Found, but with no exposed copies
198 -> return (NotFound { fr_paths = [], fr_pkg = Nothing
199 , fr_pkgs_hidden = mod_hiddens, fr_mods_hidden = pkg_hiddens
200 , fr_suggestions = [] })
202 | [(pkg_conf,_)] <- found_exposed -- Found uniquely
203 -> let pkgid = packageConfigId pkg_conf in
204 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
206 | otherwise -- Found in more than one place
207 -> return (FoundMultiple (map (packageConfigId.fst) found_exposed))
209 for_this_pkg = case mb_pkg of
211 Just p -> filter ((`matches` p) . fst) found
212 found_exposed = filter is_exposed for_this_pkg
213 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
215 mod_hiddens = [ packageConfigId pkg_conf
216 | (pkg_conf,False) <- found ]
218 pkg_hiddens = [ packageConfigId pkg_conf
219 | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
221 pkg_conf `matches` pkg
222 = case packageName pkg_conf of
223 PackageName n -> pkg == mkFastString n
225 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
226 modLocationCache hsc_env mod do_this = do
227 mb_loc <- lookupModLocationCache mlc mod
229 Just loc -> return (Found loc mod)
233 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
237 mlc = hsc_MLC hsc_env
239 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
240 addHomeModuleToFinder hsc_env mod_name loc = do
241 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
242 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
243 addToModLocationCache (hsc_MLC hsc_env) mod loc
246 uncacheModule :: HscEnv -> ModuleName -> IO ()
247 uncacheModule hsc_env mod = do
248 let this_pkg = thisPackage (hsc_dflags hsc_env)
249 removeFromFinderCache (hsc_FC hsc_env) mod
250 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
252 -- -----------------------------------------------------------------------------
253 -- The internal workers
255 -- | Search for a module in the home package only.
256 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
257 findHomeModule hsc_env mod_name =
258 homeSearchCache hsc_env mod_name $
260 dflags = hsc_dflags hsc_env
261 home_path = importPaths dflags
263 mod = mkModule (thisPackage dflags) mod_name
266 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
267 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
270 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
271 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
274 -- In compilation manager modes, we look for source files in the home
275 -- package because we can compile these automatically. In one-shot
276 -- compilation mode we look for .hi and .hi-boot files only.
277 exts | isOneShot (ghcMode dflags) = hi_exts
278 | otherwise = source_exts
281 -- special case for GHC.Prim; we won't find it in the filesystem.
282 -- This is important only when compiling the base package (where GHC.Prim
283 -- is a home module).
285 then return (Found (error "GHC.Prim ModLocation") mod)
288 searchPathExts home_path mod exts
291 -- | Search for a module in external packages only.
292 findPackageModule :: HscEnv -> Module -> IO FindResult
293 findPackageModule hsc_env mod = do
295 dflags = hsc_dflags hsc_env
296 pkg_id = modulePackageId mod
297 pkg_map = pkgIdMap (pkgState dflags)
299 case lookupPackage pkg_map pkg_id of
300 Nothing -> return (NoPackage pkg_id)
301 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
303 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
304 findPackageModule_ hsc_env mod pkg_conf =
305 modLocationCache hsc_env mod $
307 -- special case for GHC.Prim; we won't find it in the filesystem.
309 then return (Found (error "GHC.Prim ModLocation") mod)
313 dflags = hsc_dflags hsc_env
314 tag = buildTag dflags
316 -- hi-suffix for packages depends on the build tag.
317 package_hisuf | null tag = "hi"
318 | otherwise = tag ++ "_hi"
320 mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
322 import_dirs = importDirs pkg_conf
323 -- we never look for a .hi-boot file in an external package;
324 -- .hi-boot files only make sense for the home package.
327 [one] | MkDepend <- ghcMode dflags -> do
328 -- there's only one place that this .hi file can be, so
329 -- don't bother looking for it.
330 let basename = moduleNameSlashes (moduleName mod)
331 loc <- mk_hi_loc one basename
332 return (Found loc mod)
334 searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
336 -- -----------------------------------------------------------------------------
337 -- General path searching
340 :: [FilePath] -- paths to search
341 -> Module -- module name
344 FilePath -> BaseName -> IO ModLocation -- action
349 searchPathExts paths mod exts
350 = do result <- search to_search
352 hPutStrLn stderr (showSDoc $
353 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
354 , nest 2 (vcat (map text paths))
356 Succeeded (loc, p) -> text "Found" <+> ppr loc
357 Failed fs -> text "not found"])
362 basename = moduleNameSlashes (moduleName mod)
364 to_search :: [(FilePath, IO ModLocation)]
365 to_search = [ (file, fn path basename)
368 let base | path == "." = basename
369 | otherwise = path </> basename
373 search [] = return (NotFound { fr_paths = map fst to_search
374 , fr_pkg = Just (modulePackageId mod)
375 , fr_mods_hidden = [], fr_pkgs_hidden = []
376 , fr_suggestions = [] })
378 search ((file, mk_result) : rest) = do
379 b <- doesFileExist file
381 then do { loc <- mk_result; return (Found loc mod) }
384 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
385 -> FilePath -> BaseName -> IO ModLocation
386 mkHomeModLocationSearched dflags mod suff path basename = do
387 mkHomeModLocation2 dflags mod (path </> basename) suff
389 -- -----------------------------------------------------------------------------
390 -- Constructing a home module location
392 -- This is where we construct the ModLocation for a module in the home
393 -- package, for which we have a source file. It is called from three
396 -- (a) Here in the finder, when we are searching for a module to import,
397 -- using the search path (-i option).
399 -- (b) The compilation manager, when constructing the ModLocation for
400 -- a "root" module (a source file named explicitly on the command line
401 -- or in a :load command in GHCi).
403 -- (c) The driver in one-shot mode, when we need to construct a
404 -- ModLocation for a source file named on the command-line.
409 -- The name of the module
412 -- (a): The search path component where the source file was found.
416 -- (a): (moduleNameSlashes mod)
417 -- (b) and (c): The filename of the source file, minus its extension
420 -- The filename extension of the source file (usually "hs" or "lhs").
422 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
423 mkHomeModLocation dflags mod src_filename = do
424 let (basename,extension) = splitExtension src_filename
425 mkHomeModLocation2 dflags mod basename extension
427 mkHomeModLocation2 :: DynFlags
429 -> FilePath -- Of source module, without suffix
432 mkHomeModLocation2 dflags mod src_basename ext = do
433 let mod_basename = moduleNameSlashes mod
435 obj_fn <- mkObjPath dflags src_basename mod_basename
436 hi_fn <- mkHiPath dflags src_basename mod_basename
438 return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
440 ml_obj_file = obj_fn })
442 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
444 mkHiOnlyModLocation dflags hisuf path basename
445 = do let full_basename = path </> basename
446 obj_fn <- mkObjPath dflags full_basename basename
447 return ModLocation{ ml_hs_file = Nothing,
448 ml_hi_file = full_basename <.> hisuf,
449 -- Remove the .hi-boot suffix from
450 -- hi_file, if it had one. We always
451 -- want the name of the real .hi file
452 -- in the ml_hi_file field.
456 -- | Constructs the filename of a .o file for a given source file.
457 -- Does /not/ check whether the .o file exists
460 -> FilePath -- the filename of the source file, minus the extension
461 -> String -- the module name with dots replaced by slashes
463 mkObjPath dflags basename mod_basename
465 odir = objectDir dflags
466 osuf = objectSuf dflags
468 obj_basename | Just dir <- odir = dir </> mod_basename
469 | otherwise = basename
471 return (obj_basename <.> osuf)
473 -- | Constructs the filename of a .hi file for a given source file.
474 -- Does /not/ check whether the .hi file exists
477 -> FilePath -- the filename of the source file, minus the extension
478 -> String -- the module name with dots replaced by slashes
480 mkHiPath dflags basename mod_basename
485 hi_basename | Just dir <- hidir = dir </> mod_basename
486 | otherwise = basename
488 return (hi_basename <.> hisuf)
491 -- -----------------------------------------------------------------------------
492 -- Filenames of the stub files
494 -- We don't have to store these in ModLocations, because they can be derived
495 -- from other available information, and they're only rarely needed.
501 -> (FilePath,FilePath,FilePath)
503 mkStubPaths dflags mod location
505 stubdir = stubDir dflags
507 mod_basename = moduleNameSlashes mod
508 src_basename = dropExtension $ expectJust "mkStubPaths"
509 (ml_hs_file location)
512 | Just dir <- stubdir = dir </> mod_basename
513 | otherwise = src_basename
515 stub_basename = stub_basename0 ++ "_stub"
517 obj = ml_obj_file location
518 osuf = objectSuf dflags
519 stub_obj_base = dropTail (length osuf + 1) obj ++ "_stub"
520 -- NB. not takeFileName, see #3093
522 (stub_basename <.> "c",
523 stub_basename <.> "h",
524 stub_obj_base <.> objectSuf dflags)
526 -- -----------------------------------------------------------------------------
527 -- findLinkable isn't related to the other stuff in here,
528 -- but there's no other obvious place for it
530 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
531 findObjectLinkableMaybe mod locn
532 = do let obj_fn = ml_obj_file locn
533 maybe_obj_time <- modificationTimeIfExists obj_fn
534 case maybe_obj_time of
535 Nothing -> return Nothing
536 Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
538 -- Make an object linkable when we know the object file exists, and we know
539 -- its modification time.
540 findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
541 findObjectLinkable mod obj_fn obj_time = do
542 let stub_fn = (dropExtension obj_fn ++ "_stub") <.> "o"
543 stub_exist <- doesFileExist stub_fn
545 then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
546 else return (LM obj_time mod [DotO obj_fn])
548 -- -----------------------------------------------------------------------------
551 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
552 cannotFindModule = cantFindErr (sLit "Could not find module")
553 (sLit "Ambiguous module name")
555 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
556 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
557 (sLit "Ambiguous interface for")
559 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
561 cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
562 = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
563 sep [ptext (sLit "it was found in multiple packages:"),
564 hsep (map (text.packageIdString) pkgs)]
566 cantFindErr cannot_find _ dflags mod_name find_result
567 = ptext cannot_find <+> quotes (ppr mod_name)
570 pkg_map :: PackageConfigMap
571 pkg_map = pkgIdMap (pkgState dflags)
574 = case find_result of
576 -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
577 ptext (sLit "was found")
579 NotFound { fr_paths = files, fr_pkg = mb_pkg
580 , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
581 , fr_suggestions = suggest }
582 | Just pkg <- mb_pkg, pkg /= thisPackage dflags
583 -> not_found_in_package pkg files
586 -> pp_suggestions suggest $$ tried_these files
588 | null files && null mod_hiddens && null pkg_hiddens
589 -> ptext (sLit "It is not a module in the current program, or in any known package.")
592 -> vcat (map pkg_hidden pkg_hiddens) $$
593 vcat (map mod_hidden mod_hiddens) $$
596 _ -> panic "cantFindErr"
598 build_tag = buildTag dflags
600 not_found_in_package pkg files
603 build = if build_tag == "p" then "profiling"
604 else "\"" ++ build_tag ++ "\""
606 ptext (sLit "Perhaps you haven't installed the ") <> text build <>
607 ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
611 = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
612 ptext (sLit " package,") $$
613 ptext (sLit "try running 'ghc-pkg check'.") $$
618 | verbosity dflags < 3 =
619 ptext (sLit "Use -v to see a list of the files searched for.")
621 hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
624 ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
625 <> dot $$ cabal_pkg_hidden_hint pkg
626 cabal_pkg_hidden_hint pkg
627 | dopt Opt_BuildingCabalPackage dflags
628 = case simpleParse (packageIdString pkg) of
630 ptext (sLit "Perhaps you need to add") <+>
631 quotes (text (display (pkgName pid))) <+>
632 ptext (sLit "to the build-depends in your .cabal file.")
637 ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
639 pp_suggestions :: [Module] -> SDoc
642 | otherwise = hang (ptext (sLit "Perhaps you meant"))
643 2 (vcat [ vcat (map pp_exp exposed_sugs)
644 , vcat (map pp_hid hidden_sugs) ])
646 (exposed_sugs, hidden_sugs) = partition from_exposed_pkg sugs
648 from_exposed_pkg m = case lookupPackage pkg_map (modulePackageId m) of
649 Just pkg_config -> exposed pkg_config
650 Nothing -> WARN( True, ppr m ) -- Should not happen
653 pp_exp mod = ppr (moduleName mod)
654 <+> parens (ptext (sLit "from") <+> ppr (modulePackageId mod))
655 pp_hid mod = ppr (moduleName mod)
656 <+> parens (ptext (sLit "needs flag -package") <+> ppr (modulePackageId mod))