2 % (c) The University of Glasgow, 2000-2006
4 \section[Finder]{Module Finder}
13 findExposedPackageModule,
17 addHomeModuleToFinder,
21 findObjectLinkableMaybe,
34 import PrelNames ( gHC_PRIM )
38 import Maybes ( expectJust )
39 import Exception ( evaluate )
41 import Distribution.Text
42 import Distribution.Package hiding (PackageId)
43 import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef )
44 import System.Directory
45 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 -- Ideally the update to both caches be a single atomic operation.
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
80 atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
81 _ <- evaluate =<< readIORef ref
83 where is_ext mod _ | modulePackageId mod /= this_pkg = True
86 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
87 addToFinderCache ref key val =
88 atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
90 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
91 addToModLocationCache ref key val =
92 atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
94 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
95 removeFromFinderCache ref key =
96 atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
98 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
99 removeFromModLocationCache ref key =
100 atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
102 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
103 lookupFinderCache ref key = do
105 return $! lookupUFM c key
107 lookupModLocationCache :: IORef ModLocationCache -> Module
108 -> IO (Maybe ModLocation)
109 lookupModLocationCache ref key = do
111 return $! lookupModuleEnv c key
113 -- -----------------------------------------------------------------------------
114 -- The two external entry points
116 -- | Locate a module that was imported by the user. We have the
117 -- module's name, and possibly a package name. Without a package
118 -- name, this function will use the search path and the known exposed
119 -- packages to find the module, if a package is specified then only
120 -- that package is searched for the module.
122 findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
123 findImportedModule hsc_env mod_name mb_pkg =
125 Nothing -> unqual_import
126 Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
127 | otherwise -> pkg_import
129 home_import = findHomeModule hsc_env mod_name
131 pkg_import = findExposedPackageModule hsc_env mod_name mb_pkg
133 unqual_import = home_import
135 findExposedPackageModule hsc_env mod_name Nothing
137 -- | Locate a specific 'Module'. The purpose of this function is to
138 -- create a 'ModLocation' for a given 'Module', that is to find out
139 -- where the files associated with this module live. It is used when
140 -- reading the interface for a module mentioned by another interface,
141 -- for example (a "system import").
143 findExactModule :: HscEnv -> Module -> IO FindResult
144 findExactModule hsc_env mod =
145 let dflags = hsc_dflags hsc_env in
146 if modulePackageId mod == thisPackage dflags
147 then findHomeModule hsc_env (moduleName mod)
148 else findPackageModule hsc_env mod
150 -- -----------------------------------------------------------------------------
153 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
154 this `orIfNotFound` or_this = do
157 NotFound places1 _mb_pkg1 mod_hiddens1 pkg_hiddens1 -> do
160 NotFound places2 mb_pkg2 mod_hiddens2 pkg_hiddens2 ->
161 return (NotFound (places1 ++ places2)
162 mb_pkg2 -- snd arg is the package search
163 (mod_hiddens1 ++ mod_hiddens2)
164 (pkg_hiddens1 ++ pkg_hiddens2))
165 _other -> return res2
169 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
170 homeSearchCache hsc_env mod_name do_this = do
171 m <- lookupFinderCache (hsc_FC hsc_env) mod_name
173 Just result -> return result
176 addToFinderCache (hsc_FC hsc_env) mod_name result
178 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
182 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
184 findExposedPackageModule hsc_env mod_name mb_pkg
185 -- not found in any package:
186 | null found_exposed = return (NotFound [] Nothing mod_hiddens pkg_hiddens)
187 -- found in just one exposed package:
188 | [(pkg_conf, _)] <- found_exposed
189 = let pkgid = packageConfigId pkg_conf in
190 findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
192 = return (FoundMultiple (map (packageConfigId.fst) found_exposed))
194 dflags = hsc_dflags hsc_env
195 found = lookupModuleInAllPackages dflags mod_name
197 for_this_pkg = filter ((`matches` mb_pkg) . fst) found
199 found_exposed = [ (pkg_conf,exposed_mod)
200 | x@(pkg_conf,exposed_mod) <- for_this_pkg,
203 is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
205 mod_hiddens = [ packageConfigId pkg_conf
206 | (pkg_conf,False) <- found ]
208 pkg_hiddens = [ packageConfigId pkg_conf
209 | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
211 _pkg_conf `matches` Nothing = True
212 pkg_conf `matches` Just pkg =
213 case packageName pkg_conf of
214 PackageName n -> pkg == mkFastString n
217 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
218 modLocationCache hsc_env mod do_this = do
219 mb_loc <- lookupModLocationCache mlc mod
221 Just loc -> return (Found loc mod)
225 Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
229 mlc = hsc_MLC hsc_env
231 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
232 addHomeModuleToFinder hsc_env mod_name loc = do
233 let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
234 addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
235 addToModLocationCache (hsc_MLC hsc_env) mod loc
238 uncacheModule :: HscEnv -> ModuleName -> IO ()
239 uncacheModule hsc_env mod = do
240 let this_pkg = thisPackage (hsc_dflags hsc_env)
241 removeFromFinderCache (hsc_FC hsc_env) mod
242 removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
244 -- -----------------------------------------------------------------------------
245 -- The internal workers
247 -- | Search for a module in the home package only.
248 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
249 findHomeModule hsc_env mod_name =
250 homeSearchCache hsc_env mod_name $
252 dflags = hsc_dflags hsc_env
253 home_path = importPaths dflags
255 mod = mkModule (thisPackage dflags) mod_name
258 [ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
259 , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
262 hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
263 , (addBootSuffix hisuf, mkHiOnlyModLocation dflags hisuf)
266 -- In compilation manager modes, we look for source files in the home
267 -- package because we can compile these automatically. In one-shot
268 -- compilation mode we look for .hi and .hi-boot files only.
269 exts | isOneShot (ghcMode dflags) = hi_exts
270 | otherwise = source_exts
273 -- special case for GHC.Prim; we won't find it in the filesystem.
274 -- This is important only when compiling the base package (where GHC.Prim
275 -- is a home module).
277 then return (Found (error "GHC.Prim ModLocation") mod)
280 searchPathExts home_path mod exts
283 -- | Search for a module in external packages only.
284 findPackageModule :: HscEnv -> Module -> IO FindResult
285 findPackageModule hsc_env mod = do
287 dflags = hsc_dflags hsc_env
288 pkg_id = modulePackageId mod
289 pkg_map = pkgIdMap (pkgState dflags)
291 case lookupPackage pkg_map pkg_id of
292 Nothing -> return (NoPackage pkg_id)
293 Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
295 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
296 findPackageModule_ hsc_env mod pkg_conf =
297 modLocationCache hsc_env mod $
299 -- special case for GHC.Prim; we won't find it in the filesystem.
301 then return (Found (error "GHC.Prim ModLocation") mod)
305 dflags = hsc_dflags hsc_env
306 tag = buildTag dflags
308 -- hi-suffix for packages depends on the build tag.
309 package_hisuf | null tag = "hi"
310 | otherwise = tag ++ "_hi"
312 mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
314 import_dirs = importDirs pkg_conf
315 -- we never look for a .hi-boot file in an external package;
316 -- .hi-boot files only make sense for the home package.
319 [one] | MkDepend <- ghcMode dflags -> do
320 -- there's only one place that this .hi file can be, so
321 -- don't bother looking for it.
322 let basename = moduleNameSlashes (moduleName mod)
323 loc <- mk_hi_loc one basename
324 return (Found loc mod)
326 searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
328 -- -----------------------------------------------------------------------------
329 -- General path searching
332 :: [FilePath] -- paths to search
333 -> Module -- module name
336 FilePath -> BaseName -> IO ModLocation -- action
341 searchPathExts paths mod exts
342 = do result <- search to_search
344 hPutStrLn stderr (showSDoc $
345 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
346 , nest 2 (vcat (map text paths))
348 Succeeded (loc, p) -> text "Found" <+> ppr loc
349 Failed fs -> text "not found"])
354 basename = moduleNameSlashes (moduleName mod)
356 to_search :: [(FilePath, IO ModLocation)]
357 to_search = [ (file, fn path basename)
360 let base | path == "." = basename
361 | otherwise = path </> basename
365 search [] = return (NotFound (map fst to_search) (Just (modulePackageId mod))
367 search ((file, mk_result) : rest) = do
368 b <- doesFileExist file
370 then do { loc <- mk_result; return (Found loc mod) }
373 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
374 -> FilePath -> BaseName -> IO ModLocation
375 mkHomeModLocationSearched dflags mod suff path basename = do
376 mkHomeModLocation2 dflags mod (path </> basename) suff
378 -- -----------------------------------------------------------------------------
379 -- Constructing a home module location
381 -- This is where we construct the ModLocation for a module in the home
382 -- package, for which we have a source file. It is called from three
385 -- (a) Here in the finder, when we are searching for a module to import,
386 -- using the search path (-i option).
388 -- (b) The compilation manager, when constructing the ModLocation for
389 -- a "root" module (a source file named explicitly on the command line
390 -- or in a :load command in GHCi).
392 -- (c) The driver in one-shot mode, when we need to construct a
393 -- ModLocation for a source file named on the command-line.
398 -- The name of the module
401 -- (a): The search path component where the source file was found.
405 -- (a): (moduleNameSlashes mod)
406 -- (b) and (c): The filename of the source file, minus its extension
409 -- The filename extension of the source file (usually "hs" or "lhs").
411 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
412 mkHomeModLocation dflags mod src_filename = do
413 let (basename,extension) = splitExtension src_filename
414 mkHomeModLocation2 dflags mod basename extension
416 mkHomeModLocation2 :: DynFlags
418 -> FilePath -- Of source module, without suffix
421 mkHomeModLocation2 dflags mod src_basename ext = do
422 let mod_basename = moduleNameSlashes mod
424 obj_fn <- mkObjPath dflags src_basename mod_basename
425 hi_fn <- mkHiPath dflags src_basename mod_basename
427 return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
429 ml_obj_file = obj_fn })
431 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
433 mkHiOnlyModLocation dflags hisuf path basename
434 = do let full_basename = path </> basename
435 obj_fn <- mkObjPath dflags full_basename basename
436 return ModLocation{ ml_hs_file = Nothing,
437 ml_hi_file = full_basename <.> hisuf,
438 -- Remove the .hi-boot suffix from
439 -- hi_file, if it had one. We always
440 -- want the name of the real .hi file
441 -- in the ml_hi_file field.
445 -- | Constructs the filename of a .o file for a given source file.
446 -- Does /not/ check whether the .o file exists
449 -> FilePath -- the filename of the source file, minus the extension
450 -> String -- the module name with dots replaced by slashes
452 mkObjPath dflags basename mod_basename
454 odir = objectDir dflags
455 osuf = objectSuf dflags
457 obj_basename | Just dir <- odir = dir </> mod_basename
458 | otherwise = basename
460 return (obj_basename <.> osuf)
462 -- | Constructs the filename of a .hi file for a given source file.
463 -- Does /not/ check whether the .hi file exists
466 -> FilePath -- the filename of the source file, minus the extension
467 -> String -- the module name with dots replaced by slashes
469 mkHiPath dflags basename mod_basename
474 hi_basename | Just dir <- hidir = dir </> mod_basename
475 | otherwise = basename
477 return (hi_basename <.> hisuf)
480 -- -----------------------------------------------------------------------------
481 -- Filenames of the stub files
483 -- We don't have to store these in ModLocations, because they can be derived
484 -- from other available information, and they're only rarely needed.
490 -> (FilePath,FilePath,FilePath)
492 mkStubPaths dflags mod location
494 stubdir = stubDir dflags
496 mod_basename = moduleNameSlashes mod
497 src_basename = dropExtension $ expectJust "mkStubPaths"
498 (ml_hs_file location)
501 | Just dir <- stubdir = dir </> mod_basename
502 | otherwise = src_basename
504 stub_basename = stub_basename0 ++ "_stub"
506 obj = ml_obj_file location
507 osuf = objectSuf dflags
508 stub_obj_base = dropTail (length osuf + 1) obj ++ "_stub"
509 -- NB. not takeFileName, see #3093
511 (stub_basename <.> "c",
512 stub_basename <.> "h",
513 stub_obj_base <.> objectSuf dflags)
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")
542 (sLit "Ambiguous module name")
544 cannotFindInterface :: DynFlags -> ModuleName -> FindResult -> SDoc
545 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
546 (sLit "Ambiguous interface for")
548 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
550 cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
551 = hang (ptext multiple_found <+> 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 "no package matching") <+> quotes (ppr pkg) <+>
563 ptext (sLit "was found")
565 NotFound files mb_pkg mod_hiddens pkg_hiddens
566 | Just pkg <- mb_pkg, pkg /= thisPackage dflags
567 -> not_found_in_package pkg files
569 | null files && null mod_hiddens && null pkg_hiddens
570 -> ptext (sLit "it is not a module in the current program, or in any known package.")
573 -> vcat (map pkg_hidden pkg_hiddens) $$
574 vcat (map mod_hidden mod_hiddens) $$
577 NotFoundInPackage pkg
578 -> ptext (sLit "it is not in package") <+> quotes (ppr pkg)
580 _ -> panic "cantFindErr"
582 build_tag = buildTag dflags
584 not_found_in_package pkg files
587 build = if build_tag == "p" then "profiling"
588 else "\"" ++ build_tag ++ "\""
590 ptext (sLit "Perhaps you haven't installed the ") <> text build <>
591 ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
595 = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
596 ptext (sLit " package,") $$
597 ptext (sLit "try running 'ghc-pkg check'.") $$
602 | verbosity dflags < 3 =
603 ptext (sLit "Use -v to see a list of the files searched for.")
605 hang (ptext (sLit "locations searched:")) 2 $ vcat (map text files)
608 ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg)
609 <> dot $$ cabal_pkg_hidden_hint pkg
610 cabal_pkg_hidden_hint pkg
611 | dopt Opt_BuildingCabalPackage dflags
612 = case simpleParse (packageIdString pkg) of
614 ptext (sLit "Perhaps you need to add") <+>
615 quotes (text (display (pkgName pid))) <+>
616 ptext (sLit "to the build-depends in your .cabal file.")
621 ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)